      include 'gplapncd.for'
C This code was written by the program
C <TABLO  Version 5.5   February 2005>
      use tgmnz
      use gpcm
      use gsinc1
      use gsinc3
      use gsinc4
      use gsinc5
      use gsinc5b
      use gsinc6
      use gsinc7
      use gsinc8
      use gscomp
      use TGSMVL
      use gpbas1
      use tgdebg
      use gpmain1
      use smvlst0
      use psimmod1
      use psimmod2
      USE SIMRES0
      use GTAPM_
      include 'tggsdec1.for'
      CHARACTER*70 PROGNV
      PARAMETER(PROGNV=
     *'<GTAPM.for 14-JUN-2007 (a TABLO-generated program)>')
      INTEGER PRVERI
      PARAMETER(PRVERI=34000)
      CHARACTER (LEN=9) DATES
      PARAMETER(DATES='1987-2005')
      CHARACTER*6 PRNAME
      PARAMETER(PRNAME='TGPROG')
      INTEGER DMMTOG
C Map from coefficient names in code to names in model specification
C
C      Name in code       Name used in model specification
C      ---------------------------------------------------
C         C00001            VERNUM
C         C00002            SIZE_TRAD
C         C00003            SIZE_ENDW
C         C00004            SIZE_DEMD
C         C00005            SIZE_CGDS
C         C00006            SIZE_PROD
C         C00007            SLUG
C         C00008            SAVE
C         C00009            VDGA
C         C00010            VDGF
C         C00011            VDGM
C         C00012            DGMARG
C         C00013            VNDG
C         C00014            VIGA
C         C00015            VIGF
C         C00016            VIGM
C         C00017            IGMARG
C         C00018            VNIG
C         C00019            VDPA
C         C00020            VDPF
C         C00021            VDPM
C         C00022            DPMARG
C         C00023            VNDP
C         C00024            VIPA
C         C00025            VIPF
C         C00026            VIPM
C         C00027            IPMARG
C         C00028            VNIP
C         C00029            EVOA
C         C00030            EVFA
C         C00031            VDFA
C         C00032            VDFF
C         C00033            VDFM
C         C00034            DFMARG
C         C00035            VNDF
C         C00036            VIFA
C         C00037            VFM
C         C00038            VIFF
C         C00039            VIFM
C         C00040            IFMARG
C         C00041            VNIF
C         C00042            VNDX
C         C00043            XMARG
C         C00044            VXMD
C         C00045            VXFD
C         C00046            VDEP
C         C00047            VIMS
C         C00048            VIWS
C         C00049            VXWD
C         C00050            VST
C         C00051            VFA
C         C00052            VOA
C         C00053            VDM
C         C00054            VOM
C         C00055            VGA
C         C00056            GOVEXP
C         C00057            VPA
C         C00058            PRIVEXP
C         C00059            INCOME
C         C00060            DGTAX
C         C00061            IGTAX
C         C00062            TGC
C         C00063            DPTAX
C         C00064            IPTAX
C         C00065            TPC
C         C00066            DFTAX
C         C00067            IFTAX
C         C00068            TIU
C         C00069            ETAX
C         C00070            TFU
C         C00071            PTAX
C         C00072            TOUT
C         C00073            XTAXD
C         C00074            TEX
C         C00075            MTAX
C         C00076            TIM
C         C00077            ESUBD
C         C00078            REGINV
C         C00079            NETINV
C         C00080            GLOBINV
C         C00081            CONSHR
C         C00082            INCPAR
C         C00083            UELASPRIV
C         C00084            ESUBGR
C         C00085            ESUBGL
C         C00086            ESUBPR
C         C00087            ESUBPL
C         C00088            GDFRSHR
C         C00089            GDRSHR
C         C00090            GMFRSHR
C         C00091            GMRSHR
C         C00092            GMSHR
C         C00093            XWCONSHR
C         C00094            SUBPAR
C         C00095            ALPHA
C         C00096            APE
C         C00097            EY
C         C00098            EP
C         C00099            PMSHR
C         C00100            PDFRSHR
C         C00101            PDRSHR
C         C00102            PMFRSHR
C         C00103            PMRSHR
C         C00104            ESUBT
C         C00105            ESUBFR
C         C00106            ESUBFL
C         C00107            FDFRSHR
C         C00108            FDRSHR
C         C00109            FMFRSHR
C         C00110            FMRSHR
C         C00111            FMSHR
C         C00112            VVA
C         C00113            SVADEFAULT
C         C00114            SVA
C         C00115            ESUBVA
C         C00116            STC
C         C00117            VKB
C         C00118            INVKERATIO
C         C00119            GRNETRATIO
C         C00120            RORFLEX
C         C00121            RORDELTA
C         C00122            ESUBXL
C         C00123            ESUBXR
C         C00124            XRSHR
C         C00125            XFRSHR
C         C00126            MSHRS
C         C00127            ESUBM
C         C00128            VTMFSD
C         C00129            VTFSD
C         C00130            VTMPROV
C         C00131            VTMUSE
C         C00132            VTRPROV
C         C00133            VT
C         C00134            VTMUSESHR
C         C00135            VTSUPPSHR
C         C00136            VTUSE
C         C00137            VTFSD_MSH
C         C00138            VIWSCOST
C         C00139            FOBSHR
C         C00140            TRNSHR
C         C00141            XSHRPRIV
C         C00142            XSHRGOV
C         C00143            XSHRSAVE
C         C00144            TINC
C         C00145            REVSHR
C         C00146            ETRAE
C         C00147            FY
C         C00148            INDTAX
C         C00149            DPARSUM
C         C00150            UTILELAS
C         C00151            DPARPRIV
C         C00152            DPARGOV
C         C00153            DPARSAVE
C         C00154            UTILPRIV
C         C00155            UTILGOV
C         C00156            UTILSAVE
C         C00157            SHRDM
C         C00158            SHRST
C         C00159            SHRXMD
C         C00160            VIM
C         C00161            SHRIFM
C         C00162            SHRIPM
C         C00163            SHRIGM
C         C00164            SHRDFM
C         C00165            SHRDPM
C         C00166            SHRDGM
C         C00167            SHRVNDP
C         C00168            SHRVNIP
C         C00169            SHRVNDG
C         C00170            SHRVNIG
C         C00171            SHRVNDF
C         C00172            SHRVNIF
C         C00173            SHRVNDX
C         C00174            SHREM
C         C00175            VXW
C         C00176            VXWREGION
C         C00177            VIW
C         C00178            VIWREGION
C         C00179            VENDWREG
C         C00180            VENDWWLD
C         C00181            GDP
C         C00182            VXWCOMMOD
C         C00183            VXWLD
C         C00184            VIWCOMMOD
C         C00185            PW_PM
C         C00186            VOW
C         C00187            VWOW
C         C00188            VWOU
C         C00189            TBAL
C         C00190            INCOMEEV
C         C00191            UTILPRIVEV
C         C00192            UTILGOVEV
C         C00193            UTILSAVEEV
C         C00194            VPAEV
C         C00195            VPAREGEV
C         C00196            CONSHREV
C         C00197            EYEV
C         C00198            UELASPRIVEV
C         C00199            XWCONSHREV
C         C00200            PRIVEXPEV
C         C00201            GOVEXPEV
C         C00202            SAVEEV
C         C00203            XSHRPRIVEV
C         C00204            XSHRGOVEV
C         C00205            XSHRSAVEEV
C         C00206            UTILELASEV
C         C00207            EVSCALFACT
C         C00208            VTMD
C         C00209            SX_IRS
C         C00210            SXT_IR
C         C00211            VTICOMM
C         C00212            VIWDIRALL
C         C00213            VIWDATOT
C         C00214            SM_IRS
C         C00215            SMT_IR
C         C00216            SX_IR
C         C00217            SM_IR
C         C00218            SW_IR
C         C00219            SW_I
C
C Declarations of all coefficients
C      REAL C00001(1),C00002(1),C00003(1),C00004(1),C00005(1),C00006(1)
C      INTEGER C00007(0)
C      REAL C00008(0),C00009(0,0),C00010(0,0),C00011(0,0),C00012(0,0)
C      REAL C00013(0,0,0),C00014(0,0),C00015(0,0),C00016(0,0)
C      REAL C00017(0,0),C00018(0,0,0),C00019(0,0),C00020(0,0)
C      REAL C00021(0,0),C00022(0,0),C00023(0,0,0),C00024(0,0)
C      REAL C00025(0,0),C00026(0,0),C00027(0,0),C00028(0,0,0)
C      REAL C00029(0,0),C00030(0,0,0),C00031(0,0,0),C00032(0,0,0)
C      REAL C00033(0,0,0),C00034(0,0,0),C00035(0,0,0,0),C00036(0,0,0)
C      REAL C00037(0,0,0),C00038(0,0,0),C00039(0,0,0),C00040(0,0,0)
C      REAL C00041(0,0,0,0),C00042(0,0,0,0),C00043(0,0,0),C00044(0,0,0)
C      REAL C00045(0,0,0),C00046(0),C00047(0,0,0),C00048(0,0,0)
C      REAL C00049(0,0,0),C00050(0,0),C00051(0,0,0),C00052(0,0)
C      REAL C00053(0,0),C00054(0,0),C00055(0,0),C00056(0),C00057(0,0)
C      REAL C00058(0),C00059(0),C00060(0,0),C00061(0,0),C00062(0)
C      REAL C00063(0,0),C00064(0,0),C00065(0),C00066(0,0,0)
C      REAL C00067(0,0,0),C00068(0),C00069(0,0,0),C00070(0),C00071(0,0)
C      REAL C00072(0),C00073(0,0,0),C00074(0),C00075(0,0,0),C00076(0)
C      REAL C00077(0),C00078(0),C00079(0),C00080(1),C00081(0,0)
C      REAL C00082(0,0),C00083(0),C00084(0),C00085(0),C00086(0)
C      REAL C00087(0),C00088(0,0),C00089(0,0,0),C00090(0,0)
C      REAL C00091(0,0,0),C00092(0,0),C00093(0,0),C00094(0,0)
C      REAL C00095(0,0),C00096(0,0,0),C00097(0,0),C00098(0,0,0)
C      REAL C00099(0,0),C00100(0,0),C00101(0,0,0),C00102(0,0)
C      REAL C00103(0,0,0),C00104(0),C00105(0),C00106(0),C00107(0,0,0)
C      REAL C00108(0,0,0,0),C00109(0,0,0),C00110(0,0,0,0),C00111(0,0,0)
C      REAL C00112(0,0),C00113(0),C00114(0,0,0),C00115(0),C00116(0,0,0)
C      REAL C00117(0),C00118(0),C00119(0),C00120(0)
C      INTEGER C00121(1)
C      REAL C00122(0),C00123(0),C00124(0,0,0,0),C00125(0,0,0)
C      REAL C00126(0,0,0),C00127(0),C00128(0,0,0,0),C00129(0,0,0)
C      REAL C00130(0),C00131(0),C00132(0),C00133(1),C00134(0,0,0,0)
C      REAL C00135(0,0),C00136(1),C00137(0,0,0,0),C00138(0,0,0)
C      REAL C00139(0,0,0),C00140(0,0,0),C00141(0),C00142(0),C00143(0)
C      REAL C00144(0),C00145(0,0,0),C00146(0),C00147(0),C00148(0)
C      REAL C00149(0),C00150(0),C00151(0),C00152(0),C00153(0),C00154(0)
C      REAL C00155(0),C00156(0),C00157(0,0),C00158(0,0),C00159(0,0,0)
C      REAL C00160(0,0),C00161(0,0,0),C00162(0,0),C00163(0,0)
C      REAL C00164(0,0,0),C00165(0,0),C00166(0,0),C00167(0,0,0)
C      REAL C00168(0,0,0),C00169(0,0,0),C00170(0,0,0),C00171(0,0,0,0)
C      REAL C00172(0,0,0,0),C00173(0,0,0,0),C00174(0,0,0),C00175(0,0)
C      REAL C00176(0),C00177(0,0),C00178(0),C00179(0),C00180(1)
C      REAL C00181(0),C00182(0),C00183(1),C00184(0),C00185(0,0)
C      REAL C00186(0,0),C00187(0),C00188(0),C00189(0),C00190(0)
C      REAL C00191(0),C00192(0),C00193(0),C00194(0,0),C00195(0)
C      REAL C00196(0,0),C00197(0,0),C00198(0),C00199(0,0),C00200(0)
C      REAL C00201(0),C00202(0),C00203(0),C00204(0),C00205(0),C00206(0)
C      REAL C00207(0),C00208(0,0),C00209(0,0,0),C00210(0,0),C00211(0,0)
C      REAL C00212(0,0),C00213(0),C00214(0,0,0),C00215(0,0),C00216(0,0)
C      REAL C00217(0,0),C00218(0,0),C00219(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            m
C         I00005            j
C         I00006            n
C         I00007            h
C         I00008            k
C         I00009            l
      istgprog=.TRUE.
      isgemsim=.NOT.istgprog
      dmmtog=0
      mxgsrs=0
      mxgsis=0
      mxgslg=0
      mxgsop=0
      mxgsin=0
      mxgsrc=0
      mxgsic=0
      AXSFIL='GTAPM'
      AXTFIL=AXSFIL
      include 'tggscod1.for'
      include 'tggscod2.for'
      include 'tggscod3.for'
200    CONTINUE
      include 'tggscod4.for'
      CALL M00001(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF((DOEQ.OR.DOCLOS.OR.WRSVI).AND.FSTPAS
     *     .AND.NOXSS.AND. .NOT.SZENDN) THEN
      include 'tggsen1.for'
      END IF
      IF(KSINTA.EQ.1.AND.(PGDSIM.OR.DOSHCK).AND.FSTPAS.AND.NOXSSW
     *    .AND.(.NOT.SHDONE).AND.(.NOT.ABTSIM).AND.(.NOT.ISFNLV)) THEN
      include 'tggsshk1.for'
      END IF
      IF(.NOT.DOCBC) GOTO 3000
      CALL 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
      LSACTP='1'
      LSACNO=0
      IF(EXSUSE) THEN
        CALL GPREW(EXSUN,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
1000  CONTINUE
      IF((DOEQ.OR.DOCLOS.OR.WRSVI).AND.FSTPAS.AND. .NOT.SZENDN) THEN
       IF(DIDPRE.OR.(LSACTP.EQ.ENACTP.AND.ENACNO.EQ.LSACNO)) THEN
      include 'tggsen1.for'
       END IF
      END IF
      IF(KSINTA.EQ.1.AND.(PGDSIM.OR.DOSHCK).AND.FSTPAS.AND.
     *    (.NOT.SHDONE).AND.(.NOT.ABTSIM)) THEN
       IF(ISFNLV.OR.(LSACTP.EQ.SHACTP.AND.LSACNO.GE.SHACNO)) THEN
      include 'tggsshk1.for'
       END IF
      END IF
      IF(.NOT.DOCBC) GOTO 3000
      include 'tgdeac3t.for'
      include 'tggscod5.for'
      include 'tggscod6.for'
      IF(.NOT.DOEQ) GOTO 8100
      include 'tggscod7.for'
 360  CONTINUE
      include 'tggscod8.for'
      CALL M00007(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 M00008(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 M00009(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 M00010(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 M00011(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 M00012(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00013(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00014(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00015(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00016(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00017(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00018(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00019(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00020(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00021(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00022(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00023(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00024(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00025(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPCPU(XX8,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(RCPU) THEN
        CALL GPTOG('t',0, '[CPU for %t is %r seconds.]',
     *    '\x','\x','equations',' ',' ',0,0,XX8-XX7,0.0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
        CALL GPTOG('t',0, '[CPU for formulas and %s is %r seconds.]',
     *    '\x','\x','equations',' ',' ',0,0,XX8-XX4,0.0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(MCOSHM) THEN
       CALL ALLMCO1(1,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGWDMSTSOL(TBCOL,DEBG(123),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
3000  CONTINUE
      CALL GPCPU(XX9,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      include 'tggssim0.for'
 3010 CONTINUE
      include 'tggseqb1.for'
 3380 CONTINUE
      include 'tggsbs1.for'
      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 M00026(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 M00027(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 M00028(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) GOTO 8260
      include 'tggsud1.for'
 8260 CONTINUE
      include 'tggsud2.for'
      GOTO 5900
5850  CONTINUE
      include 'tggspre1.for'
      include 'tggspre2.for'
      include 'tggsei0.for'
      include 'tggsudx1.for'
 8300 CONTINUE
      include 'tggsei1.for'
8360  CONTINUE
      include 'tggsecp1.for'
      include 'tggsend1.for'
8100  CONTINUE
      include 'tggsend2.for'
9000  CONTINUE
      include 'tggsend3.for'
      END
      SUBROUTINE S00001(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00002,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00002(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_TRAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(2)
      RS1=RS1+1
    1 CONTINUE
      C00002(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_TRAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00001')
      RETURN
      END
      SUBROUTINE S00002(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00003,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00003(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_ENDW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(6)
      RS1=RS1+1
    1 CONTINUE
      C00003(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_ENDW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00002')
      RETURN
      END
      SUBROUTINE S00003(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00004,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00004(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_DEMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(8)
      RS1=RS1+1
    1 CONTINUE
      C00004(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_DEMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00003')
      RETURN
      END
      SUBROUTINE S00004(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00002,C00003,C00004,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER ASSVAL,MMEL,ELAD(MMNST)
      LOGICAL ASSOK
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00002(1)
      REAL C00003(1)
      REAL C00004(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      ASSOK=.TRUE.
      RS1=0.0
      LG1=C00004(1).EQ.C00002(1)+C00003(1)
      IF(LG1) THEN
      RS1=1
      END IF
      ASSVAL=RS1
      IF(ASSVAL.NE.1) THEN
        CALL TGASF1(ASSOK,0,
     *' ',
     *    0,0,0,0,0,0,0,
     *    0,0,0,0,0,0,0,
     *  MMNST,ELAD,STELST,STNM,MMEL,STEL,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
        ASSOK=.FALSE.
      END IF
      IF(.NOT.ASSOK) THEN
       CALL TGASFCV('tg',31,
     *' ',
     *   ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
       CALL TGASF2(
     *' ',
     *   ASSOK,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00004')
      RETURN
15500 CALL PERETM('S00004',ERRMES)
      RETURN
      END
      SUBROUTINE S00005(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00005,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00005(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_CGDS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(5)
      RS1=RS1+1
    1 CONTINUE
      C00005(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_CGDS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00005')
      RETURN
      END
      SUBROUTINE S00006(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00006,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00006(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_PROD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(7)
      RS1=RS1+1
    1 CONTINUE
      C00006(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_PROD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00006')
      RETURN
      END
      SUBROUTINE S00007(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00002,C00005,C00006,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER ASSVAL,MMEL,ELAD(MMNST)
      LOGICAL ASSOK
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00002(1)
      REAL C00005(1)
      REAL C00006(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      ASSOK=.TRUE.
      RS1=0.0
      LG1=C00006(1).EQ.C00002(1)+C00005(1)
      IF(LG1) THEN
      RS1=1
      END IF
      ASSVAL=RS1
      IF(ASSVAL.NE.1) THEN
        CALL TGASF1(ASSOK,0,
     *' ',
     *    0,0,0,0,0,0,0,
     *    0,0,0,0,0,0,0,
     *  MMNST,ELAD,STELST,STNM,MMEL,STEL,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
        ASSOK=.FALSE.
      END IF
      IF(.NOT.ASSOK) THEN
       CALL TGASFCV('tg',36,
     *' ',
     *   ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
       CALL TGASF2(
     *' ',
     *   ASSOK,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00007')
      RETURN
15500 CALL PERETM('S00007',ERRMES)
      RETURN
      END
      SUBROUTINE S00008(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00007,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00007(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      LOGICAL RUNTSS,PRELIM,DOPRE,DIDPRE
      INTEGER NSSMP
      COMMON /TGPREI/DOPRE,PRELIM,DIDPRE
      COMMON /TGTPSI/NSSMP,RUNTSS
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for set:',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      IF((PRELIM.OR.POSTSIMPASS2).AND.RUNTSS) THEN
        SSMPST(10)=NSSMP+1
        CALL TGINCP(NSSMP+SSZ(6),DSSMP,'DSSMP',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      LG1=C00007(I00001).GT.0
      IF(LG1) THEN
      RS1=1
      END IF
      SSMP(SSMPST(10)-1+I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for set:',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00008')
      RETURN
      END
      SUBROUTINE M00001(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE GTAPM_c5
      USE GTAPM_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(80,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(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(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
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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(46,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(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(62,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(68,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(70,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(72,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(78,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(83,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(117,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(118,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(132,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(141,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(142,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(143,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(148,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(149,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(153,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(154,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(176,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(178,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(179,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(181,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(195,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(198,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(200,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(201,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(202,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(203,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(204,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(205,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(206,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(207,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(213,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(9,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(10,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(11,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(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(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(44,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(45,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(47,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(49,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(53,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(55,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(57,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(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(81,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(82,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(92,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(93,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(94,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(95,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(96,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(97,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(98,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(99,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(127,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(138,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(139,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(140,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(157,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(159,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(160,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(162,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(163,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(165,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(166,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(182,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(184,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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) 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(194,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(199,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(212,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(216,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(217,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(218,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(219,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      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(50,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(128,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(130,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(131,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(134,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(135,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(137,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(208,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(210,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(211,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(215,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(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(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(22,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(23,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(42,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(43,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(84,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(85,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(86,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(87,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(88,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(89,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(90,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(91,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(105,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(106,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(124,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(125,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(167,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(168,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(169,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(170,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(173,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(29,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
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(30,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(31,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(36,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(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(66,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(104,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(107,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(108,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(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(145,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(164,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(171,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(172,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.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(51,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(116,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.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(52,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(54,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(71,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=8
       SSNO=7
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,7,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=5
       SSNO=8
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,8,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=7
       SSNO=9
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,9,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(26).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_TRAD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00001(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(26),
     *  C00002,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(28).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_ENDW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00002(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(28),
     *  C00003,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(30).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_DEMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00003(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(30),
     *  C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(31).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
      CALL GPTO(' Assertion',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      CALL S00004(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(31),
     *  C00002,C00003,C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(33).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_CGDS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00005(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(33),
     *  C00005,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(35).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_PROD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00006(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(35),
     *  C00006,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(36).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
      CALL GPTO(' Assertion',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      CALL S00007(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(36),
     *  C00002,C00005,C00006,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(40).EQ.'y') THEN
        CALL GPTO1(' Formula for set ''%t''',
     *    'ENDWS_COMM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00008(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(40),
     *  C00007,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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=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(174,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
      RETURN
15000 CALL PERET('M00001')
      RETURN
      END
      SUBROUTINE S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00030,C00051,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00030(SSZ(6),SSZ(7),SSZ(1))
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      C00051(SSMP(SSMPST(5)-1+I00001),I00005,I00002)=
     *  C00030(I00001,I00005,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00009')
      RETURN
      END
      SUBROUTINE S00010(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00031,C00036,C00051,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00031(SSZ(2),SSZ(7),SSZ(1))
      REAL C00036(SSZ(2),SSZ(7),SSZ(1))
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00051(SSMP(SSMPST(6)-1+I00001),I00005,I00003)=
     *  C00031(I00001,I00005,I00003)+C00036(I00001,I00005,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00010')
      RETURN
      END
      SUBROUTINE S00011(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00029,C00052,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00052(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)=
     *  C00029(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00011')
      RETURN
      END
      SUBROUTINE S00012(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00052,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00052(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(7)
      RS1=0.0
      DO 3 I00005=1,SSZ(8)
      RS1=RS1+C00051(I00005,I00001,I00002)
    3 CONTINUE
      C00052(SSMP(SSMPST(9)-1+I00001),I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00012')
      RETURN
      END
      SUBROUTINE S00013(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00011,C00021,C00033,C00053,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00033(SSZ(2),SSZ(7),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00006=1,SSZ(4)
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1+C00033(SSMP(SSMPST(2)-1+I00006),I00005,I00002)
    3 CONTINUE
      C00053(SSMP(SSMPST(2)-1+I00006),I00002)=C00021(SSMP(SSMPST(2)-1+
     *  I00006),I00002)+C00011(SSMP(SSMPST(2)-1+I00006),I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00013')
      RETURN
      END
      SUBROUTINE S00014(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00011,C00013,C00018,C00021,C00023,C00028,C00033,C00035,
     *  C00041,C00042,C00053,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00013(SSZ(4),SSZ(3),SSZ(1))
      REAL C00018(SSZ(4),SSZ(3),SSZ(1))
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00023(SSZ(4),SSZ(3),SSZ(1))
      REAL C00028(SSZ(4),SSZ(3),SSZ(1))
      REAL C00033(SSZ(2),SSZ(7),SSZ(1))
      REAL C00035(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00042(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1+C00033(SSMP(SSMPST(1)-1+I00004),I00005,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00001=1,SSZ(4)
      RS2=RS2+C00023(I00001,I00004,I00002)
    4 CONTINUE
      RS3=0.0
      DO 5 I00001=1,SSZ(4)
      RS3=RS3+C00028(I00001,I00004,I00002)
    5 CONTINUE
      RS4=0.0
      DO 6 I00001=1,SSZ(4)
      RS4=RS4+C00013(I00001,I00004,I00002)
    6 CONTINUE
      RS5=0.0
      DO 7 I00001=1,SSZ(4)
      RS5=RS5+C00018(I00001,I00004,I00002)
    7 CONTINUE
      RS6=0.0
      DO 9 I00005=1,SSZ(7)
      RS7=0.0
      DO 8 I00001=1,SSZ(4)
      RS7=RS7+C00035(I00001,I00004,I00005,I00002)
    8 CONTINUE
      RS6=RS6+RS7
    9 CONTINUE
      RS8=0.0
      DO 11 I00005=1,SSZ(7)
      RS9=0.0
      DO 10 I00001=1,SSZ(4)
      RS9=RS9+C00041(I00001,I00004,I00005,I00002)
   10 CONTINUE
      RS8=RS8+RS9
   11 CONTINUE
      RS10=0.0
      DO 12 I00003=1,SSZ(1)
      RS11=0.0
      DO 13 I00005=1,SSZ(4)
      RS11=RS11+C00042(I00004,I00005,I00002,I00003)
   13 CONTINUE
      RS10=RS10+RS11
   12 CONTINUE
      C00053(SSMP(SSMPST(1)-1+I00004),I00002)=C00021(SSMP(SSMPST(1)-1+
     *  I00004),I00002)+C00011(SSMP(SSMPST(1)-1+I00004),I00002)+RS1+RS2+
     *  RS3+RS4+RS5+RS6+RS8+RS10
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00014')
      RETURN
      END
      SUBROUTINE S00015(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00037,C00054,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00037(SSZ(6),SSZ(7),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1+C00037(I00001,I00005,I00002)
    3 CONTINUE
      C00054(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00015')
      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 GTAPM_c5
      USE GTAPM_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,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(263).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(263),
     *  C00030,C00051,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(264).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00010(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(264),
     *  C00031,C00036,C00051,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(266).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00011(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(266),
     *  C00029,C00052,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(267).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00012(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(267),
     *  C00051,C00052,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(269).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VDM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00013(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(269),
     *  C00011,C00021,C00033,C00053,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(270).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VDM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00014(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(270),
     *  C00011,C00013,C00018,C00021,C00023,C00028,C00033,C00035,
     *  C00041,C00042,C00053,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(272).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00015(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(272),
     *  C00037,C00054,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00002')
      RETURN
      END
      SUBROUTINE S00016(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00044,C00050,C00053,C00054,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00044(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00044(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
    3 CONTINUE
      C00054(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004))),I00002)=C00053(SSMP(SSMPST(1)-1+I00004),I00002)+RS1+
     *  C00050(I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00016')
      RETURN
      END
      SUBROUTINE S00017(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00044,C00053,C00054,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00044(SSZ(2),SSZ(1),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00044(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00054(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001))),I00002)=C00053(SSMP(SSMPST(2)-1+I00001),I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00017')
      RETURN
      END
      SUBROUTINE S00018(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00052,C00054,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00007=1,SSZ(5)
      C00054(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)=
     *  C00052(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00018')
      RETURN
      END
      SUBROUTINE S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00009,C00014,C00055,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00009(SSZ(2),SSZ(1))
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00055(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00055(I00001,I00003)=C00009(I00001,I00003)+C00014(I00001,I00003)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00019')
      RETURN
      END
      SUBROUTINE S00020(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(1))
      REAL C00056(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GOVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00055(I00001,I00002)
    2 CONTINUE
      C00056(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GOVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00020')
      RETURN
      END
      SUBROUTINE S00021(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00024,C00057,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00024(SSZ(2),SSZ(1))
      REAL C00057(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00057(I00001,I00003)=C00019(I00001,I00003)+C00024(I00001,I00003)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00021')
      RETURN
      END
      SUBROUTINE S00022(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00057,C00058,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00057(SSZ(2),SSZ(1))
      REAL C00058(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PRIVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00057(I00001,I00002)
    2 CONTINUE
      C00058(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PRIVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00022')
      RETURN
      END
      SUBROUTINE S00023(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00008,C00056,C00058,C00059,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL C00056(SSZ(1))
      REAL C00058(SSZ(1))
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOME"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00059(I00002)=C00058(I00002)+C00056(I00002)+C00008(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INCOME"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00023')
      RETURN
      END
      SUBROUTINE S00024(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00009,C00010,C00060,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00009(SSZ(2),SSZ(1))
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00060(I00001,I00002)=C00009(I00001,I00002)-C00010(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00024')
      RETURN
      END
      SUBROUTINE S00025(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00014,C00015,C00061,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00061(I00001,I00002)=C00014(I00001,I00002)-C00015(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00025')
      RETURN
      END
      SUBROUTINE S00026(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00062,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00062(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TGC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00060(I00001,I00002)+C00061(I00001,I00002)
    2 CONTINUE
      C00062(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TGC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00026')
      RETURN
      END
      SUBROUTINE S00027(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00020,C00063,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00063(I00001,I00002)=C00019(I00001,I00002)-C00020(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00027')
      RETURN
      END
      SUBROUTINE S00028(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00025,C00064,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(1))
      REAL C00025(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00064(I00001,I00002)=C00024(I00001,I00002)-C00025(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00028')
      RETURN
      END
      SUBROUTINE S00029(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00063,C00064,C00065,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TPC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00063(I00001,I00002)+C00064(I00001,I00002)
    2 CONTINUE
      C00065(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TPC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00029')
      RETURN
      END
      SUBROUTINE S00030(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00031,C00032,C00066,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00031(SSZ(2),SSZ(7),SSZ(1))
      REAL C00032(SSZ(2),SSZ(7),SSZ(1))
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00066(I00001,I00005,I00002)=C00031(I00001,I00005,I00002)-
     *  C00032(I00001,I00005,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00030')
      RETURN
      END
      SUBROUTINE S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00038,C00067,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00036(SSZ(2),SSZ(7),SSZ(1))
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00067(I00001,I00005,I00002)=C00036(I00001,I00005,I00002)-
     *  C00038(I00001,I00005,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00031')
      RETURN
      END
      SUBROUTINE S00032(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00066,C00067,C00068,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00068(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TIU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00005=1,SSZ(7)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00066(I00001,I00005,I00002)+C00067(I00001,I00005,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      C00068(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TIU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00032')
      RETURN
      END
      SUBROUTINE S00033(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00037,C00051,C00069,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00037(SSZ(6),SSZ(7),SSZ(1))
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "ETAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      C00069(I00001,I00005,I00002)=C00051(SSMP(SSMPST(5)-1+
     *  I00001),I00005,I00002)-C00037(I00001,I00005,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "ETAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00033')
      RETURN
      END
      SUBROUTINE S00034(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00069,C00070,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TFU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(6)
      RS2=RS2+C00069(I00001,I00005,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00070(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TFU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00034')
      RETURN
      END
      SUBROUTINE S00035(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00052,C00054,C00071,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      REAL C00071(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(9)
      C00071(I00001,I00002)=C00054(I00001,I00002)-C00052(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00035')
      RETURN
      END
      SUBROUTINE S00036(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00071,C00072,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00072(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TOUT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(7)
      RS1=RS1+C00071(SSMP(SSMPST(9)-1+I00001),I00002)
    2 CONTINUE
      C00072(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TOUT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00036')
      RETURN
      END
      SUBROUTINE S00037(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00045,C00049,C00073,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00045(SSZ(2),SSZ(1),SSZ(1))
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XTAXD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00073(I00001,I00002,I00003)=C00049(I00001,I00002,I00003)-
     *  C00045(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XTAXD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00037')
      RETURN
      END
      SUBROUTINE S00038(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00073,C00074,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TEX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+C00073(I00001,I00002,I00003)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00074(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TEX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00038')
      RETURN
      END
      SUBROUTINE S00039(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00047,C00048,C00075,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00047(SSZ(2),SSZ(1),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "MTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00075(I00001,I00002,I00003)=C00047(I00001,I00002,I00003)-
     *  C00048(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "MTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00039')
      RETURN
      END
      SUBROUTINE S00040(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00075,C00076,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00076(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+C00075(I00001,I00003,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00076(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00040')
      RETURN
      END
      SUBROUTINE S00041(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00052,C00078,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00078(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "REGINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00008=1,SSZ(5)
      RS1=RS1+C00052(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00002)
    2 CONTINUE
      C00078(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "REGINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00041')
      RETURN
      END
      SUBROUTINE S00042(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00046,C00052,C00079,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00079(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NETINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00008=1,SSZ(5)
      RS1=RS1+C00052(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00002)
    2 CONTINUE
      C00079(I00002)=RS1-C00046(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "NETINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00042')
      RETURN
      END
      SUBROUTINE S00043(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00079,C00080,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00079(SSZ(1))
      REAL C00080(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GLOBINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00002=1,SSZ(1)
      RS1=RS1+C00079(I00002)
    1 CONTINUE
      C00080(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GLOBINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00043')
      RETURN
      END
      SUBROUTINE S00044(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00057,C00081,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00057(SSZ(2),SSZ(1))
      REAL C00081(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00008=1,SSZ(2)
      RS1=RS1+C00057(I00008,I00002)
    3 CONTINUE
      RS2=C00057(I00001,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00081(I00001,I00002)=RS4
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00044')
      RETURN
      END
      SUBROUTINE S00045(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00082,C00083,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00082(SSZ(2),SSZ(1))
      REAL C00083(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UELASPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00081(I00001,I00002)*C00082(I00001,I00002)
    2 CONTINUE
      C00083(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UELASPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00045')
      RETURN
      END
      SUBROUTINE S00046(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00012,C00088,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00012(SSZ(4),SSZ(1))
      REAL C00088(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GDFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=C00012(I00001,I00002)
      RS2=C00010(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00088(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GDFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00046')
      RETURN
      END
      SUBROUTINE S00047(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00012,C00013,C00089,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00012(SSZ(4),SSZ(1))
      REAL C00013(SSZ(4),SSZ(3),SSZ(1))
      REAL C00089(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GDRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00013(I00001,I00004,I00002)
      RS2=C00012(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00089(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GDRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00047')
      RETURN
      END
      SUBROUTINE S00048(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00015,C00017,C00090,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00017(SSZ(4),SSZ(1))
      REAL C00090(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GMFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=C00017(I00001,I00002)
      RS2=C00015(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00090(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GMFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00048')
      RETURN
      END
      SUBROUTINE S00049(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00017,C00018,C00091,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00017(SSZ(4),SSZ(1))
      REAL C00018(SSZ(4),SSZ(3),SSZ(1))
      REAL C00091(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GMRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00018(I00001,I00004,I00002)
      RS2=C00017(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00091(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GMRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00049')
      RETURN
      END
      SUBROUTINE S00050(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00014,C00055,C00092,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00055(SSZ(2),SSZ(1))
      REAL C00092(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00014(I00001,I00003)
      RS2=C00055(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00092(I00001,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00050')
      RETURN
      END
      SUBROUTINE S00051(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00082,C00083,C00093,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00082(SSZ(2),SSZ(1))
      REAL C00083(SSZ(1))
      REAL C00093(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XWCONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00081(I00001,I00002)*C00082(I00001,I00002)
      RS2=C00083(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00093(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XWCONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00051')
      RETURN
      END
      SUBROUTINE S00052(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00094,C00095,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00094(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "ALPHA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00095(I00001,I00002)=1  -C00094(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "ALPHA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00052')
      RETURN
      END
      SUBROUTINE S00053(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00095,C00096,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00006
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00008=1,SSZ(2)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00006=1,SSZ(2)
      RS1=RS1+C00081(I00006,I00002)*C00095(I00006,I00002)
    4 CONTINUE
      C00096(I00001,I00008,I00002)=C00095(I00001,I00002)+
     *  C00095(I00008,I00002)-RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00053')
      RETURN
      END
      SUBROUTINE S00054(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00095,C00096,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00006
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00006=1,SSZ(2)
      RS1=RS1+C00081(I00006,I00002)*C00095(I00006,I00002)
    3 CONTINUE
      RS2=C00095(I00001,I00002)
      RS3=C00081(I00001,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00096(I00001,I00001,I00002)=2.0*C00095(I00001,I00002)-RS1-RS4
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00054')
      RETURN
      END
      SUBROUTINE S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00082,C00095,C00097,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00006
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00082(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00097(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00006=1,SSZ(2)
      RS1=RS1+C00081(I00006,I00002)*C00082(I00006,I00002)
    3 CONTINUE
      RS2=1.0
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      RS5=0.0
      DO 4 I00006=1,SSZ(2)
      RS5=RS5+C00081(I00006,I00002)*C00082(I00006,I00002)*
     *  C00095(I00006,I00002)
    4 CONTINUE
      RS6=0.0
      DO 5 I00006=1,SSZ(2)
      RS6=RS6+C00081(I00006,I00002)*C00095(I00006,I00002)
    5 CONTINUE
      C00097(I00001,I00002)=RS4*(C00082(I00001,I00002)*(1.0-
     *  C00095(I00001,I00002))+RS5)+C00095(I00001,I00002)-RS6
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00055')
      RETURN
      END
      SUBROUTINE S00056(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00098,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00098(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00008=1,SSZ(2)
      DO 1 I00001=1,SSZ(2)
      C00098(I00001,I00008,I00002)=0
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00056')
      RETURN
      END
      SUBROUTINE S00057(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00096,C00097,C00098,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00097(SSZ(2),SSZ(1))
      REAL C00098(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00008=1,SSZ(2)
      DO 1 I00001=1,SSZ(2)
      C00098(I00001,I00008,I00002)=(C00096(I00001,I00008,I00002)-
     *  C00097(I00001,I00002))*C00081(I00008,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00057')
      RETURN
      END
      SUBROUTINE S00058(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00057,C00099,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(1))
      REAL C00057(SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00024(I00001,I00003)
      RS2=C00057(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00099(I00001,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00058')
      RETURN
      END
      SUBROUTINE 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 GTAPM_c5
      USE GTAPM_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(273).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00016(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(273),
     *  C00044,C00050,C00053,C00054,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(274).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00017(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(274),
     *  C00044,C00053,C00054,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(275).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00018(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(275),
     *  C00052,C00054,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(277).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(277),
     *  C00009,C00014,C00055,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(279).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GOVEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00020(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(279),
     *  C00055,C00056,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(281).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00021(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(281),
     *  C00019,C00024,C00057,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(283).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PRIVEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00022(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(283),
     *  C00057,C00058,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(285).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00023(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(285),
     *  C00008,C00056,C00058,C00059,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(287).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DGTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00024(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(287),
     *  C00009,C00010,C00060,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(289).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IGTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00025(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(289),
     *  C00014,C00015,C00061,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(291).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TGC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00026(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(291),
     *  C00060,C00061,C00062,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(293).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00027(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(293),
     *  C00019,C00020,C00063,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(295).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IPTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00028(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(295),
     *  C00024,C00025,C00064,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(297).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TPC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00029(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(297),
     *  C00063,C00064,C00065,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(299).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DFTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00030(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(299),
     *  C00031,C00032,C00066,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(301).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IFTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(301),
     *  C00036,C00038,C00067,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(303).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00032(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(303),
     *  C00066,C00067,C00068,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(305).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'ETAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00033(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(305),
     *  C00037,C00051,C00069,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(307).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TFU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00034(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(307),
     *  C00069,C00070,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(309).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00035(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(309),
     *  C00052,C00054,C00071,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(311).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TOUT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00036(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(311),
     *  C00071,C00072,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(313).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XTAXD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00037(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(313),
     *  C00045,C00049,C00073,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(315).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00038(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(315),
     *  C00073,C00074,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(317).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00039(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(317),
     *  C00047,C00048,C00075,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(319).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00040(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(319),
     *  C00075,C00076,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(323).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REGINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00041(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(323),
     *  C00052,C00078,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(325).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NETINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00042(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(325),
     *  C00046,C00052,C00079,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(327).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GLOBINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00043(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(327),
     *  C00079,C00080,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(329).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CONSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00044(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(329),
     *  C00057,C00081,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(333).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UELASPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00045(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(333),
     *  C00081,C00082,C00083,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(351).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GDFRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00046(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(351),
     *  C00010,C00012,C00088,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(356).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GDRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00047(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(356),
     *  C00012,C00013,C00089,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(361).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GMFRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00048(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(361),
     *  C00015,C00017,C00090,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(365).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GMRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00049(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(365),
     *  C00017,C00018,C00091,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(368).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00050(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(368),
     *  C00014,C00055,C00092,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(386).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XWCONSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00051(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(386),
     *  C00081,C00082,C00083,C00093,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(391).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'ALPHA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00052(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(391),
     *  C00094,C00095,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(393).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'APE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00053(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(393),
     *  C00081,C00095,C00096,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(394).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'APE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00054(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(394),
     *  C00081,C00095,C00096,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(396).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(396),
     *  C00081,C00082,C00095,C00097,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(398).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00056(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(398),
     *  C00098,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(399).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00057(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(399),
     *  C00081,C00096,C00097,C00098,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(412).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00058(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(412),
     *  C00024,C00057,C00099,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00003')
      RETURN
      END
      SUBROUTINE S00059(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00020,C00022,C00100,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00022(SSZ(4),SSZ(1))
      REAL C00100(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PDFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=C00022(I00001,I00002)
      RS2=C00020(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00100(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PDFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00059')
      RETURN
      END
      SUBROUTINE S00060(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00022,C00023,C00101,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00022(SSZ(4),SSZ(1))
      REAL C00023(SSZ(4),SSZ(3),SSZ(1))
      REAL C00101(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PDRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00023(I00001,I00004,I00002)
      RS2=C00022(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00101(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PDRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00060')
      RETURN
      END
      SUBROUTINE S00061(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00025,C00027,C00102,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00025(SSZ(2),SSZ(1))
      REAL C00027(SSZ(4),SSZ(1))
      REAL C00102(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PMFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=C00027(I00001,I00002)
      RS2=C00025(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00102(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PMFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00061')
      RETURN
      END
      SUBROUTINE S00062(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00028,C00103,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00027(SSZ(4),SSZ(1))
      REAL C00028(SSZ(4),SSZ(3),SSZ(1))
      REAL C00103(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PMRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00028(I00001,I00004,I00002)
      RS2=C00027(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00103(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PMRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00062')
      RETURN
      END
      SUBROUTINE S00063(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00032,C00034,C00107,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(7),SSZ(1))
      REAL C00034(SSZ(4),SSZ(7),SSZ(1))
      REAL C00107(SSZ(4),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FDFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(4)
      RS1=C00034(I00001,I00005,I00002)
      RS2=C00032(SSMP(SSMPST(2)-1+I00001),I00005,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00107(I00001,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FDFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00063')
      RETURN
      END
      SUBROUTINE S00064(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00035,C00108,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00034(SSZ(4),SSZ(7),SSZ(1))
      REAL C00035(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00108(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FDRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(1)
      DO 3 I00005=1,SSZ(7)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00035(I00001,I00004,I00005,I00002)
      RS2=C00034(I00001,I00005,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00108(I00001,I00004,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FDRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00064')
      RETURN
      END
      SUBROUTINE S00065(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00038,C00040,C00109,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL C00040(SSZ(4),SSZ(7),SSZ(1))
      REAL C00109(SSZ(4),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FMFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(4)
      RS1=C00040(I00001,I00005,I00002)
      RS2=C00038(SSMP(SSMPST(2)-1+I00001),I00005,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00109(I00001,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FMFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00065')
      RETURN
      END
      SUBROUTINE S00066(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00040,C00041,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00040(SSZ(4),SSZ(7),SSZ(1))
      REAL C00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00110(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FMRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(1)
      DO 3 I00005=1,SSZ(7)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00041(I00001,I00004,I00005,I00002)
      RS2=C00040(I00001,I00005,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00110(I00001,I00004,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FMRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00066')
      RETURN
      END
      SUBROUTINE S00067(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00051,C00111,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00036(SSZ(2),SSZ(7),SSZ(1))
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00111(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00036(I00001,I00005,I00003)
      RS2=C00051(SSMP(SSMPST(6)-1+I00001),I00005,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00111(I00001,I00005,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00067')
      RETURN
      END
      SUBROUTINE S00068(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00112,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00112(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(6)
      RS1=RS1+C00051(SSMP(SSMPST(5)-1+I00001),I00005,I00002)
    3 CONTINUE
      C00112(I00005,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00068')
      RETURN
      END
      SUBROUTINE S00069(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00112,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00112(SSZ(7),SSZ(1))
      REAL C00113(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SVADEFAULT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00005=1,SSZ(7)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS2=RS2+C00112(I00005,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      DO 3 I00001=1,SSZ(6)
      RS3=0.0
      DO 4 I00005=1,SSZ(7)
      RS4=0.0
      DO 5 I00002=1,SSZ(1)
      RS4=RS4+C00051(SSMP(SSMPST(5)-1+I00001),I00005,I00002)
    5 CONTINUE
      RS3=RS3+RS4
    4 CONTINUE
      RS5=RS3
      RS6=RS1
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE IF(RS5.EQ.0.0) THEN
        RS7=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS7=1.0
        IER=4
      END IF
      C00113(I00001)=RS7
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SVADEFAULT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00069')
      RETURN
      END
      SUBROUTINE S00070(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00112,C00114,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00112(SSZ(7),SSZ(1))
      REAL C00114(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(6)
      DO 2 I00005=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00112(I00005,I00002).NE.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00051(SSMP(SSMPST(5)-1+I00001),I00005,I00002)
      RS2=C00112(I00005,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00114(I00001,I00005,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00070')
      RETURN
      END
      SUBROUTINE S00071(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00112,C00113,C00114,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00112(SSZ(7),SSZ(1))
      REAL C00113(SSZ(6))
      REAL C00114(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(6)
      DO 2 I00005=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00112(I00005,I00002).EQ.0
      IF(.NOT.LG1) GOTO     3
      C00114(I00001,I00005,I00002)=C00113(I00001)
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00071')
      RETURN
      END
      SUBROUTINE S00072(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00116,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00116(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "STC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(8)
      RS1=0.0
      DO 4 I00008=1,SSZ(8)
      RS1=RS1+C00051(I00008,I00005,I00002)
    4 CONTINUE
      RS2=C00051(I00001,I00005,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00116(I00001,I00005,I00002)=RS4
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "STC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00072')
      RETURN
      END
      SUBROUTINE S00073(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00078,C00079,C00117,C00118,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(SSZ(1))
      REAL C00117(SSZ(1))
      REAL C00118(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INVKERATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00078(I00002)
      RS2=C00117(I00002)+C00079(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00118(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INVKERATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00073')
      RETURN
      END
      SUBROUTINE S00074(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00046,C00052,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00119(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GRNETRATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00007=1,SSZ(12)
      RS1=RS1+C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00007))),I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00007=1,SSZ(12)
      RS2=RS2+C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00007))),I00002)
    3 CONTINUE
      RS3=RS1
      RS4=RS2-C00046(I00002)
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE IF(RS3.EQ.0.0) THEN
        RS5=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS5=1.0
        IER=4
      END IF
      C00119(I00002)=RS5
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GRNETRATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00074')
      RETURN
      END
      SUBROUTINE S00075(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00042,C00043,C00124,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00042(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      REAL C00043(SSZ(4),SSZ(1),SSZ(1))
      REAL C00124(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(4)
      DO 1 I00004=1,SSZ(3)
      RS1=C00042(I00004,I00005,I00002,I00003)
      RS2=C00043(I00005,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00124(I00004,I00005,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00075')
      RETURN
      END
      SUBROUTINE S00076(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00043,C00045,C00125,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00043(SSZ(4),SSZ(1),SSZ(1))
      REAL C00045(SSZ(2),SSZ(1),SSZ(1))
      REAL C00125(SSZ(4),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(4)
      RS1=C00043(I00005,I00002,I00003)
      RS2=C00045(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00125(I00005,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XFRSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00076')
      RETURN
      END
      SUBROUTINE S00077(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00047,C00126,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00047(SSZ(2),SSZ(1),SSZ(1))
      REAL C00126(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "MSHRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)
      RS1=RS1+C00047(I00001,I00008,I00003)
    4 CONTINUE
      RS2=C00047(I00001,I00002,I00003)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00126(I00001,I00002,I00003)=RS4
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "MSHRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00077')
      RETURN
      END
      SUBROUTINE S00078(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00128,C00129,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00129(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00004=1,SSZ(3)
      RS1=RS1+C00128(I00004,I00001,I00002,I00003)
    4 CONTINUE
      C00129(I00001,I00002,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00078')
      RETURN
      END
      SUBROUTINE S00079(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00130,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00130(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00050(I00004,I00002)
    2 CONTINUE
      C00130(I00004)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00079')
      RETURN
      END
      SUBROUTINE S00080(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00128,C00131,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00131(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00002=1,SSZ(1)
      RS3=0.0
      DO 2 I00001=1,SSZ(2)
      RS3=RS3+C00128(I00004,I00001,I00002,I00003)
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00131(I00004)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00080')
      RETURN
      END
      SUBROUTINE S00081(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00132,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00132(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTRPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00004=1,SSZ(3)
      RS1=RS1+C00050(I00004,I00002)
    2 CONTINUE
      C00132(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTRPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00081')
      RETURN
      END
      SUBROUTINE S00082(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00133,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00133(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS2=0.0
      DO 1 I00004=1,SSZ(3)
      RS2=RS2+C00050(I00004,I00002)
    1 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      C00133(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00082')
      RETURN
      END
      SUBROUTINE S00083(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00129,C00133,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00129(SSZ(2),SSZ(1),SSZ(1))
      REAL C00133(1)
      REAL C00134(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00004=1,SSZ(3)
      RS1=C00129(I00001,I00002,I00003)
      RS2=C00133(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00134(I00004,I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00083')
      RETURN
      END
      SUBROUTINE S00084(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00128,C00131,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00131(SSZ(3))
      REAL C00134(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00004=1,SSZ(3)
      LG1=C00131(I00004).NE.0.0
      IF(.NOT.LG1) GOTO     1
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      RS1=C00128(I00004,I00001,I00002,I00003)
      RS2=C00131(I00004)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00134(I00004,I00001,I00002,I00003)=RS3
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00084')
      RETURN
      END
      SUBROUTINE S00085(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00132,C00133,C00135,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00132(SSZ(1))
      REAL C00133(1)
      REAL C00135(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=C00132(I00002)
      RS2=C00133(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00135(I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00085')
      RETURN
      END
      SUBROUTINE S00086(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00130,C00135,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00130(SSZ(3))
      REAL C00135(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00004=1,SSZ(3)
      LG1=C00130(I00004).NE.0.0
      IF(.NOT.LG1) GOTO     1
      DO 2 I00002=1,SSZ(1)
      RS1=C00050(I00004,I00002)
      RS2=C00130(I00004)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00135(I00004,I00002)=RS3
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00086')
      RETURN
      END
      SUBROUTINE S00087(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00128,C00136,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00136(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00002=1,SSZ(1)
      RS3=0.0
      DO 2 I00001=1,SSZ(2)
      RS4=0.0
      DO 1 I00004=1,SSZ(3)
      RS4=RS4+C00128(I00004,I00001,I00002,I00003)
    1 CONTINUE
      RS3=RS3+RS4
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00136(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00087')
      RETURN
      END
      SUBROUTINE S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00128,C00129,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00129(SSZ(2),SSZ(1),SSZ(1))
      REAL C00137(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      LG1=C00129(I00001,I00002,I00003).GT.0.0
      IF(.NOT.LG1) GOTO     4
      RS1=C00128(I00004,I00001,I00002,I00003)
      RS2=C00129(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00137(I00004,I00001,I00002,I00003)=RS3
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00088')
      RETURN
      END
      SUBROUTINE S00089(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00129,C00131,C00136,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00129(SSZ(2),SSZ(1),SSZ(1))
      REAL C00131(SSZ(3))
      REAL C00136(1)
      REAL C00137(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      LG1=C00129(I00001,I00002,I00003).EQ.0.0
      IF(.NOT.LG1) GOTO     4
      RS1=C00131(I00004)
      RS2=C00136(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00137(I00004,I00001,I00002,I00003)=RS3
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00089')
      RETURN
      END
      SUBROUTINE S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00129,C00138,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00129(SSZ(2),SSZ(1),SSZ(1))
      REAL C00138(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWSCOST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00138(I00001,I00002,I00003)=C00049(I00001,I00002,I00003)+
     *  C00129(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWSCOST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00090')
      RETURN
      END
      SUBROUTINE S00091(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00138,C00139,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00138(SSZ(2),SSZ(1),SSZ(1))
      REAL C00139(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FOBSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00049(I00001,I00002,I00003)
      RS2=C00138(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00139(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FOBSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00091')
      RETURN
      END
      SUBROUTINE S00092(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00129,C00138,C00140,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00129(SSZ(2),SSZ(1),SSZ(1))
      REAL C00138(SSZ(2),SSZ(1),SSZ(1))
      REAL C00140(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TRNSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00129(I00001,I00002,I00003)
      RS2=C00138(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00140(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TRNSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00092')
      RETURN
      END
      SUBROUTINE S00093(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00058,C00059,C00141,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00058(SSZ(1))
      REAL C00059(SSZ(1))
      REAL C00141(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00058(I00002)
      RS2=C00059(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00141(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00093')
      RETURN
      END
      SUBROUTINE S00094(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00056,C00059,C00142,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00056(SSZ(1))
      REAL C00059(SSZ(1))
      REAL C00142(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00056(I00002)
      RS2=C00059(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00142(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00094')
      RETURN
      END
      SUBROUTINE S00095(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00008,C00059,C00143,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL C00059(SSZ(1))
      REAL C00143(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00008(I00002)
      RS2=C00059(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00143(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00095')
      RETURN
      END
      SUBROUTINE S00096(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00071,C00144,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00144(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1+C00071(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      C00144(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00096')
      RETURN
      END
      SUBROUTINE S00097(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00037,C00145,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00037(SSZ(6),SSZ(7),SSZ(1))
      REAL C00145(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "REVSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      DO 4 I00008=1,SSZ(7)
      RS1=RS1+C00037(I00001,I00008,I00002)
    4 CONTINUE
      RS2=C00037(I00001,I00005,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00145(I00001,I00005,I00002)=RS4
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "REVSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00097')
      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 GTAPM_c5
      USE GTAPM_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(417).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PDFRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00059(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(417),
     *  C00020,C00022,C00100,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(422).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PDRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00060(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(422),
     *  C00022,C00023,C00101,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(430).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PMFRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00061(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(430),
     *  C00025,C00027,C00102,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(434).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PMRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00062(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(434),
     *  C00027,C00028,C00103,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(473).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FDFRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00063(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(473),
     *  C00032,C00034,C00107,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(478).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FDRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00064(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(478),
     *  C00034,C00035,C00108,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(484).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FMFRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00065(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(484),
     *  C00038,C00040,C00109,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(488).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FMRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00066(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(488),
     *  C00040,C00041,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(492).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00067(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(492),
     *  C00036,C00051,C00111,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(513).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00068(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(513),
     *  C00051,C00112,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(515).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SVADEFAULT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00069(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(515),
     *  C00051,C00112,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(517).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00070(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(517),
     *  C00051,C00112,C00114,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(518).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00071(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(518),
     *  C00112,C00113,C00114,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(528).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'STC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00072(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(528),
     *  C00051,C00116,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(545).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INVKERATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00073(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(545),
     *  C00078,C00079,C00117,C00118,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(548).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GRNETRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00074(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(548),
     *  C00046,C00052,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(572).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00075(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(572),
     *  C00042,C00043,C00124,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(578).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XFRSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00076(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(578),
     *  C00043,C00045,C00125,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(589).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MSHRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00077(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(589),
     *  C00047,C00126,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(611).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00078(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(611),
     *  C00128,C00129,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(613).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMPROV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00079(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(613),
     *  C00050,C00130,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(615).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00080(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(615),
     *  C00128,C00131,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(617).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTRPROV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00081(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(617),
     *  C00050,C00132,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(619).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00082(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(619),
     *  C00050,C00133,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(622).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00083(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(622),
     *  C00129,C00133,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(623).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00084(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(623),
     *  C00128,C00131,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(626).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTSUPPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00085(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(626),
     *  C00132,C00133,C00135,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(627).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTSUPPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00086(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(627),
     *  C00050,C00130,C00135,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(630).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00087(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(630),
     *  C00128,C00136,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(632).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(632),
     *  C00128,C00129,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(633).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00089(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(633),
     *  C00129,C00131,C00136,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(638).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWSCOST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(638),
     *  C00049,C00129,C00138,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(640).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FOBSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00091(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(640),
     *  C00049,C00138,C00139,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(642).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TRNSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00092(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(642),
     *  C00129,C00138,C00140,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(645).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00093(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(645),
     *  C00058,C00059,C00141,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(647).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRGOV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00094(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(647),
     *  C00056,C00059,C00142,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(649).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRSAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00095(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(649),
     *  C00008,C00059,C00143,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(656).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00096(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(656),
     *  C00071,C00144,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(659).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REVSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00097(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(659),
     *  C00037,C00145,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00004')
      RETURN
      END
      SUBROUTINE S00098(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00046,C00054,C00147,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      REAL C00147(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1+C00054(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      C00147(I00002)=RS1-C00046(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00098')
      RETURN
      END
      SUBROUTINE S00099(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00062,C00065,C00068,C00070,C00072,C00074,C00076,C00148,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00062(SSZ(1))
      REAL C00065(SSZ(1))
      REAL C00068(SSZ(1))
      REAL C00070(SSZ(1))
      REAL C00072(SSZ(1))
      REAL C00074(SSZ(1))
      REAL C00076(SSZ(1))
      REAL C00148(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INDTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00148(I00002)=C00065(I00002)+C00062(I00002)+C00068(I00002)+
     *  C00070(I00002)+C00072(I00002)+C00074(I00002)+C00076(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INDTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00099')
      RETURN
      END
      SUBROUTINE S00100(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00083,C00141,C00142,C00143,C00149,C00150,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00083(SSZ(1))
      REAL C00141(SSZ(1))
      REAL C00142(SSZ(1))
      REAL C00143(SSZ(1))
      REAL C00149(SSZ(1))
      REAL C00150(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILELAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00083(I00002)*C00141(I00002)+C00142(I00002)+C00143(I00002)
      RS2=C00149(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00150(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILELAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00100')
      RETURN
      END
      SUBROUTINE S00101(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00083,C00141,C00150,C00151,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00083(SSZ(1))
      REAL C00141(SSZ(1))
      REAL C00150(SSZ(1))
      REAL C00151(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00083(I00002)*C00141(I00002)
      RS2=C00150(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00151(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPARPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00101')
      RETURN
      END
      SUBROUTINE S00102(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00142,C00150,C00152,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00142(SSZ(1))
      REAL C00150(SSZ(1))
      REAL C00152(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00142(I00002)
      RS2=C00150(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00152(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPARGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00102')
      RETURN
      END
      SUBROUTINE S00103(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00143,C00150,C00153,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00143(SSZ(1))
      REAL C00150(SSZ(1))
      REAL C00153(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00143(I00002)
      RS2=C00150(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00153(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPARSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00103')
      RETURN
      END
      SUBROUTINE S00104(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00154,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00154(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00154(I00002)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00104')
      RETURN
      END
      SUBROUTINE S00105(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00155,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00155(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00155(I00002)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00105')
      RETURN
      END
      SUBROUTINE S00106(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00156,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00156(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00156(I00002)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00106')
      RETURN
      END
      SUBROUTINE S00107(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00053,C00054,C00157,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      REAL C00157(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00053(I00001,I00002)
      RS2=C00054(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00157(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00107')
      RETURN
      END
      SUBROUTINE S00108(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00054,C00158,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      REAL C00158(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=C00050(I00004,I00002)
      RS2=C00054(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004))),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00158(I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00108')
      RETURN
      END
      SUBROUTINE S00109(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00044,C00054,C00159,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00044(SSZ(2),SSZ(1),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      REAL C00159(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00044(I00001,I00002,I00003)
      RS2=C00054(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00159(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00109')
      RETURN
      END
      SUBROUTINE S00110(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00016,C00026,C00039,C00160,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(1))
      REAL C00039(SSZ(2),SSZ(7),SSZ(1))
      REAL C00160(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1+C00039(I00001,I00005,I00002)
    3 CONTINUE
      C00160(I00001,I00002)=RS1+C00026(I00001,I00002)+
     *  C00016(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00110')
      RETURN
      END
      SUBROUTINE S00111(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00039,C00160,C00161,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00039(SSZ(2),SSZ(7),SSZ(1))
      REAL C00160(SSZ(2),SSZ(1))
      REAL C00161(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00039(I00001,I00005,I00002)
      RS2=C00160(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00161(I00001,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00111')
      RETURN
      END
      SUBROUTINE S00112(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00160,C00162,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(1))
      REAL C00160(SSZ(2),SSZ(1))
      REAL C00162(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00026(I00001,I00002)
      RS2=C00160(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00162(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00112')
      RETURN
      END
      SUBROUTINE S00113(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00016,C00160,C00163,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00160(SSZ(2),SSZ(1))
      REAL C00163(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00016(I00001,I00002)
      RS2=C00160(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00163(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00113')
      RETURN
      END
      SUBROUTINE S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00053,C00164,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(7),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00164(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00033(I00001,I00005,I00002)
      RS2=C00053(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00164(I00001,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00114')
      RETURN
      END
      SUBROUTINE S00115(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00053,C00165,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00165(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00021(I00001,I00002)
      RS2=C00053(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00165(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00115')
      RETURN
      END
      SUBROUTINE S00116(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00011,C00053,C00166,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00166(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00011(I00001,I00002)
      RS2=C00053(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00166(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00116')
      RETURN
      END
      SUBROUTINE S00117(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00023,C00053,C00167,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00023(SSZ(4),SSZ(3),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00167(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRVNDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00023(I00001,I00004,I00002)
      RS2=C00053(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00167(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRVNDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00117')
      RETURN
      END
      SUBROUTINE S00118(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00028,C00053,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00028(SSZ(4),SSZ(3),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00168(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRVNIP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00028(I00001,I00004,I00002)
      RS2=C00053(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00168(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRVNIP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00118')
      RETURN
      END
      SUBROUTINE S00119(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00053,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00013(SSZ(4),SSZ(3),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00169(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRVNDG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00013(I00001,I00004,I00002)
      RS2=C00053(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00169(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRVNDG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00119')
      RETURN
      END
      SUBROUTINE S00120(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00018,C00053,C00170,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00018(SSZ(4),SSZ(3),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00170(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRVNIG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00018(I00001,I00004,I00002)
      RS2=C00053(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00170(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRVNIG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00120')
      RETURN
      END
      SUBROUTINE S00121(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00035,C00053,C00171,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00035(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00171(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRVNDF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(1)
      DO 3 I00005=1,SSZ(7)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00035(I00001,I00004,I00005,I00002)
      RS2=C00053(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00171(I00001,I00004,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRVNDF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00121')
      RETURN
      END
      SUBROUTINE S00122(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00041,C00053,C00172,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00172(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRVNIF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(1)
      DO 3 I00005=1,SSZ(7)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00041(I00001,I00004,I00005,I00002)
      RS2=C00053(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00172(I00001,I00004,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRVNIF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00122')
      RETURN
      END
      SUBROUTINE S00123(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00042,C00053,C00173,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00042(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00173(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRVNDX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(4)
      DO 1 I00004=1,SSZ(3)
      RS1=C00042(I00004,I00005,I00002,I00003)
      RS2=C00053(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00173(I00004,I00005,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRVNDX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00123')
      RETURN
      END
      SUBROUTINE S00124(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00037,C00054,C00174,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00037(SSZ(6),SSZ(7),SSZ(1))
      REAL C00054(SSZ(9),SSZ(1))
      REAL C00174(SSZ(11),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHREM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(11)
      RS1=C00037(SSMP(SSMPST(11)-1+I00001),I00005,I00002)
      RS2=C00054(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001))),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00174(I00001,I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHREM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00124')
      RETURN
      END
      SUBROUTINE S00125(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00175,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
    3 CONTINUE
      C00175(SSMP(SSMPST(1)-1+I00004),I00002)=RS1+C00050(I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00125')
      RETURN
      END
      SUBROUTINE S00126(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00175,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00175(SSMP(SSMPST(2)-1+I00001),I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00126')
      RETURN
      END
      SUBROUTINE S00127(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00175,C00176,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      REAL C00176(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00175(I00001,I00002)
    2 CONTINUE
      C00176(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00127')
      RETURN
      END
      SUBROUTINE S00128(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00177,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1),SSZ(1))
      REAL C00177(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00048(I00001,I00002,I00003)
    3 CONTINUE
      C00177(I00001,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00128')
      RETURN
      END
      SUBROUTINE S00129(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00177,C00178,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00177(SSZ(2),SSZ(1))
      REAL C00178(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00177(I00001,I00002)
    2 CONTINUE
      C00178(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00129')
      RETURN
      END
      SUBROUTINE S00130(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00054,C00179,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00054(SSZ(9),SSZ(1))
      REAL C00179(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VENDWREG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1+C00054(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      C00179(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VENDWREG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00130')
      RETURN
      END
      SUBROUTINE S00131(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00179,C00180,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00179(SSZ(1))
      REAL C00180(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VENDWWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00002=1,SSZ(1)
      RS1=RS1+C00179(I00002)
    1 CONTINUE
      C00180(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VENDWWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00131')
      RETURN
      END
      SUBROUTINE S00132(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00050,C00052,C00055,C00057,C00181,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1),SSZ(1))
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00055(SSZ(2),SSZ(1))
      REAL C00057(SSZ(2),SSZ(1))
      REAL C00181(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00057(I00001,I00003)
    2 CONTINUE
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00055(I00001,I00003)
    3 CONTINUE
      RS3=0.0
      DO 4 I00008=1,SSZ(5)
      RS3=RS3+C00052(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00003)
    4 CONTINUE
      RS4=0.0
      DO 6 I00002=1,SSZ(1)
      RS5=0.0
      DO 5 I00001=1,SSZ(2)
      RS5=RS5+C00049(I00001,I00003,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    6 CONTINUE
      RS6=0.0
      DO 7 I00004=1,SSZ(3)
      RS6=RS6+C00050(I00004,I00003)
    7 CONTINUE
      RS7=0.0
      DO 9 I00002=1,SSZ(1)
      RS8=0.0
      DO 8 I00001=1,SSZ(2)
      RS8=RS8+C00048(I00001,I00002,I00003)
    8 CONTINUE
      RS7=RS7+RS8
    9 CONTINUE
      C00181(I00003)=RS1+RS2+RS3+RS4+RS6-RS7
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00132')
      RETURN
      END
      SUBROUTINE S00133(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00175,C00182,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      REAL C00182(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00175(I00001,I00002)
    2 CONTINUE
      C00182(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00133')
      RETURN
      END
      SUBROUTINE S00134(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00176,C00183,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00176(SSZ(1))
      REAL C00183(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00002=1,SSZ(1)
      RS1=RS1+C00176(I00002)
    1 CONTINUE
      C00183(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00134')
      RETURN
      END
      SUBROUTINE S00135(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00177,C00184,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00177(SSZ(2),SSZ(1))
      REAL C00184(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00177(I00001,I00002)
    2 CONTINUE
      C00184(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00135')
      RETURN
      END
      SUBROUTINE S00136(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00044,C00049,C00185,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      REAL C00044(SSZ(2),SSZ(1),SSZ(1))
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00185(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PW_PM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00049(I00001,I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=RS2+C00044(I00001,I00002,I00003)
    4 CONTINUE
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE IF(RS3.EQ.0.0) THEN
        RS5=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS5=1.0
        IER=4
      END IF
      C00185(I00001,I00002)=RS5
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PW_PM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00136')
      RETURN
      END
      SUBROUTINE S00137(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00053,C00185,C00186,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00185(SSZ(2),SSZ(1))
      REAL C00186(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
    3 CONTINUE
      C00186(SSMP(SSMPST(1)-1+I00004),I00002)=C00053(SSMP(SSMPST(1)-1+
     *  I00004),I00002)*C00185(SSMP(SSMPST(1)-1+I00004),I00002)+RS1+
     *  C00050(I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00137')
      RETURN
      END
      SUBROUTINE S00138(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00053,C00185,C00186,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00053(SSZ(2),SSZ(1))
      REAL C00185(SSZ(2),SSZ(1))
      REAL C00186(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00186(SSMP(SSMPST(2)-1+I00001),I00002)=C00053(SSMP(SSMPST(2)-1+
     *  I00001),I00002)*C00185(SSMP(SSMPST(2)-1+I00001),I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00138')
      RETURN
      END
      SUBROUTINE S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00186,C00187,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00186(SSZ(2),SSZ(1))
      REAL C00187(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VWOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00186(I00001,I00002)
    2 CONTINUE
      C00187(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VWOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00139')
      RETURN
      END
      SUBROUTINE S00140(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00055,C00057,C00188,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(1))
      REAL C00057(SSZ(2),SSZ(1))
      REAL C00188(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VWOU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00005=1,SSZ(7)
      RS2=RS2+C00051(SSMP(SSMPST(6)-1+I00001),I00005,I00003)
    3 CONTINUE
      RS1=RS1+C00057(I00001,I00003)+C00055(I00001,I00003)+RS2
    2 CONTINUE
      C00188(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VWOU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00140')
      RETURN
      END
      SUBROUTINE S00141(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00176,C00178,C00189,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00176(SSZ(1))
      REAL C00178(SSZ(1))
      REAL C00189(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TBAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00189(I00002)=C00176(I00002)-C00178(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TBAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00141')
      RETURN
      END
      SUBROUTINE S00142(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00059,C00190,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      REAL C00190(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00190(I00002)=C00059(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00142')
      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 GTAPM_c5
      USE GTAPM_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,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(665).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00098(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(665),
     *  C00046,C00054,C00147,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(669).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INDTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00099(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(669),
     *  C00062,C00065,C00068,C00070,C00072,C00074,C00076,C00148,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(689).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILELAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00100(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(689),
     *  C00083,C00141,C00142,C00143,C00149,C00150,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(691).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00101(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(691),
     *  C00083,C00141,C00150,C00151,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(693).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARGOV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00102(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(693),
     *  C00142,C00150,C00152,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(695).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARSAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00103(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(695),
     *  C00143,C00150,C00153,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(697).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
      CALL S00104(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(697),
     *  C00154,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(701).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
      CALL S00105(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(701),
     *  C00155,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(705).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
      CALL S00106(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(705),
     *  C00156,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(715).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00107(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(715),
     *  C00053,C00054,C00157,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(717).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00108(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(717),
     *  C00050,C00054,C00158,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(719).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRXMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00109(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(719),
     *  C00044,C00054,C00159,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(723).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00110(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(723),
     *  C00016,C00026,C00039,C00160,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(725).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00111(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(725),
     *  C00039,C00160,C00161,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(727).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00112(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(727),
     *  C00026,C00160,C00162,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(729).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00113(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(729),
     *  C00016,C00160,C00163,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(732).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(732),
     *  C00033,C00053,C00164,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(734).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00115(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(734),
     *  C00021,C00053,C00165,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(736).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00116(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(736),
     *  C00011,C00053,C00166,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(739).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRVNDP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00117(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(739),
     *  C00023,C00053,C00167,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(741).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRVNIP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00118(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(741),
     *  C00028,C00053,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(743).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRVNDG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00119(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(743),
     *  C00013,C00053,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(745).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRVNIG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00120(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(745),
     *  C00018,C00053,C00170,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(747).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRVNDF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00121(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(747),
     *  C00035,C00053,C00171,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(749).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRVNIF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00122(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(749),
     *  C00041,C00053,C00172,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(751).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRVNDX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00123(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(751),
     *  C00042,C00053,C00173,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(754).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHREM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00124(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(754),
     *  C00037,C00054,C00174,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(768).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00125(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(768),
     *  C00049,C00050,C00175,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(769).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00126(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(769),
     *  C00049,C00175,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(771).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWREGION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00127(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(771),
     *  C00175,C00176,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(773).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00128(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(773),
     *  C00048,C00177,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(775).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWREGION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00129(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(775),
     *  C00177,C00178,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(779).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00130(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(779),
     *  C00054,C00179,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(783).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00131(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(783),
     *  C00179,C00180,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(793).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GDP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00132(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(793),
     *  C00048,C00049,C00050,C00052,C00055,C00057,C00181,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(804).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWCOMMOD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00133(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(804),
     *  C00175,C00182,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(806).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00134(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(806),
     *  C00176,C00183,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(808).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWCOMMOD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00135(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(808),
     *  C00177,C00184,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(810).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PW_PM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00136(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(810),
     *  C00044,C00049,C00185,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(812).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00137(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(812),
     *  C00049,C00050,C00053,C00185,C00186,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(813).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00138(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(813),
     *  C00049,C00053,C00185,C00186,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(815).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(815),
     *  C00186,C00187,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(817).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00140(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(817),
     *  C00051,C00055,C00057,C00188,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(871).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00141(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(871),
     *  C00176,C00178,C00189,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(887).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
      CALL S00142(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(887),
     *  C00059,C00190,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00005')
      RETURN
      END
      SUBROUTINE S00143(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00154,C00191,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00154(SSZ(1))
      REAL C00191(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00191(I00002)=C00154(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00143')
      RETURN
      END
      SUBROUTINE S00144(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00155,C00192,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00155(SSZ(1))
      REAL C00192(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00192(I00002)=C00155(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00144')
      RETURN
      END
      SUBROUTINE S00145(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00156,C00193,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00156(SSZ(1))
      REAL C00193(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00193(I00002)=C00156(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00145')
      RETURN
      END
      SUBROUTINE S00146(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00057,C00194,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00057(SSZ(2),SSZ(1))
      REAL C00194(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00194(I00001,I00002)=C00057(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00146')
      RETURN
      END
      SUBROUTINE S00147(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00194,C00195,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00194(SSZ(2),SSZ(1))
      REAL C00195(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAREGEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00194(I00001,I00002)
    2 CONTINUE
      C00195(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VPAREGEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00147')
      RETURN
      END
      SUBROUTINE S00148(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00194,C00195,C00196,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00194(SSZ(2),SSZ(1))
      REAL C00195(SSZ(1))
      REAL C00196(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00194(I00001,I00002)
      RS2=C00195(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00196(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00148')
      RETURN
      END
      SUBROUTINE S00149(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00082,C00095,C00196,C00197,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00006
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00082(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00196(SSZ(2),SSZ(1))
      REAL C00197(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EYEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00006=1,SSZ(2)
      RS1=RS1+C00196(I00006,I00002)*C00082(I00006,I00002)
    3 CONTINUE
      RS2=1.0
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      RS5=0.0
      DO 4 I00006=1,SSZ(2)
      RS5=RS5+C00196(I00006,I00002)*C00082(I00006,I00002)*
     *  C00095(I00006,I00002)
    4 CONTINUE
      RS6=0.0
      DO 5 I00006=1,SSZ(2)
      RS6=RS6+C00196(I00006,I00002)*C00095(I00006,I00002)
    5 CONTINUE
      C00197(I00001,I00002)=RS4*(C00082(I00001,I00002)*(1.0-
     *  C00095(I00001,I00002))+RS5)+C00095(I00001,I00002)-RS6
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EYEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00149')
      RETURN
      END
      SUBROUTINE S00150(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00082,C00196,C00198,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00082(SSZ(2),SSZ(1))
      REAL C00196(SSZ(2),SSZ(1))
      REAL C00198(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UELASPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00196(I00001,I00002)*C00082(I00001,I00002)
    2 CONTINUE
      C00198(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UELASPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00150')
      RETURN
      END
      SUBROUTINE S00151(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00082,C00196,C00198,C00199,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00082(SSZ(2),SSZ(1))
      REAL C00196(SSZ(2),SSZ(1))
      REAL C00198(SSZ(1))
      REAL C00199(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XWCONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00196(I00001,I00002)*C00082(I00001,I00002)
      RS2=C00198(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00199(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XWCONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00151')
      RETURN
      END
      SUBROUTINE S00152(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00058,C00200,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00058(SSZ(1))
      REAL C00200(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00200(I00002)=C00058(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00152')
      RETURN
      END
      SUBROUTINE S00153(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00056,C00201,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00056(SSZ(1))
      REAL C00201(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00201(I00002)=C00056(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00153')
      RETURN
      END
      SUBROUTINE S00154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00008,C00202,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL C00202(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00202(I00002)=C00008(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00154')
      RETURN
      END
      SUBROUTINE S00155(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00190,C00200,C00203,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00190(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00203(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00200(I00002)
      RS2=C00190(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00203(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00155')
      RETURN
      END
      SUBROUTINE S00156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00190,C00201,C00204,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00190(SSZ(1))
      REAL C00201(SSZ(1))
      REAL C00204(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00201(I00002)
      RS2=C00190(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00204(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00156')
      RETURN
      END
      SUBROUTINE S00157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00190,C00202,C00205,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00190(SSZ(1))
      REAL C00202(SSZ(1))
      REAL C00205(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00202(I00002)
      RS2=C00190(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00205(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00157')
      RETURN
      END
      SUBROUTINE S00158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00150,C00206,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00150(SSZ(1))
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00206(I00002)=C00150(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00158')
      RETURN
      END
      SUBROUTINE S00159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00059,C00150,C00190,C00206,C00207,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      REAL C00150(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00206(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EVSCALFACT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00206(I00002)
      RS2=C00150(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      RS4=C00190(I00002)
      RS5=C00059(I00002)
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE IF(RS4.EQ.0.0) THEN
        RS6=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS6=1.0
        IER=4
      END IF
      C00207(I00002)=RS3*RS6
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EVSCALFACT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00159')
      RETURN
      END
      SUBROUTINE S00160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00128,C00208,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00208(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS2=0.0
      DO 4 I00001=1,SSZ(2)
      RS2=RS2+C00128(I00004,I00001,I00002,I00003)
    4 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00208(I00004,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00160')
      RETURN
      END
      SUBROUTINE S00161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00209,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00209(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00004=1,SSZ(3)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00008)
    3 CONTINUE
      DO 4 I00003=1,SSZ(1)
      RS2=C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      RS3=RS1+C00050(I00004,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00209(SSMP(SSMPST(1)-1+I00004),I00002,I00003)=RS4
    4 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00161')
      RETURN
      END
      SUBROUTINE S00162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00209,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00209(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(4)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00008)
    3 CONTINUE
      DO 4 I00003=1,SSZ(1)
      RS2=C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00209(SSMP(SSMPST(2)-1+I00001),I00002,I00003)=RS4
    4 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00162')
      RETURN
      END
      SUBROUTINE S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00210,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00210(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SXT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00008)
    3 CONTINUE
      RS2=C00050(I00004,I00002)
      RS3=RS1+C00050(I00004,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00210(I00004,I00002)=RS4
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SXT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00163')
      RETURN
      END
      SUBROUTINE S00164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00128,C00211,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00211(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTICOMM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS2=0.0
      DO 4 I00001=1,SSZ(2)
      RS2=RS2+C00128(I00004,I00001,I00002,I00003)
    4 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00211(I00004,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTICOMM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00164')
      RETURN
      END
      SUBROUTINE S00165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00211,C00212,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00211(SSZ(3),SSZ(1))
      REAL C00212(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
    3 CONTINUE
      C00212(SSMP(SSMPST(1)-1+I00004),I00003)=RS1+C00211(I00004,I00003)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00165')
      RETURN
      END
      SUBROUTINE S00166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00212,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00212(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00212(SSMP(SSMPST(2)-1+I00001),I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00166')
      RETURN
      END
      SUBROUTINE S00167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00212,C00213,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00212(SSZ(2),SSZ(1))
      REAL C00213(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDATOT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00212(I00001,I00003)
    2 CONTINUE
      C00213(I00003)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWDATOT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00167')
      RETURN
      END
      SUBROUTINE S00168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00212,C00214,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00212(SSZ(2),SSZ(1))
      REAL C00214(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SM_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00049(I00001,I00002,I00003)
      RS2=C00212(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00214(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SM_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00168')
      RETURN
      END
      SUBROUTINE S00169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00211,C00212,C00215,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00003
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00211(SSZ(3),SSZ(1))
      REAL C00212(SSZ(2),SSZ(1))
      REAL C00215(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SMT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=C00211(I00004,I00003)
      RS2=C00212(SSMP(SSMPST(1)-1+I00004),I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00215(I00004,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SMT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00169')
      RETURN
      END
      SUBROUTINE S00170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00216,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00008
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00216(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=0.0
      DO 4 I00008=1,SSZ(2)
      RS3=RS3+C00049(I00008,I00002,I00003)
    4 CONTINUE
      RS2=RS2+RS3
    5 CONTINUE
      RS4=0.0
      DO 6 I00009=1,SSZ(3)
      RS4=RS4+C00050(I00009,I00002)
    6 CONTINUE
      RS5=RS1+C00050(I00004,I00002)
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE
        RS7=1.0
        IER=2
      END IF
      C00216(SSMP(SSMPST(1)-1+I00004),I00002)=RS7
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00170')
      RETURN
      END
      SUBROUTINE S00171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00216,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00216(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=0.0
      DO 4 I00008=1,SSZ(2)
      RS3=RS3+C00049(I00008,I00002,I00003)
    4 CONTINUE
      RS2=RS2+RS3
    5 CONTINUE
      RS4=0.0
      DO 6 I00009=1,SSZ(3)
      RS4=RS4+C00050(I00009,I00002)
    6 CONTINUE
      RS5=RS1
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE
        RS7=1.0
        IER=2
      END IF
      C00216(SSMP(SSMPST(2)-1+I00001),I00002)=RS7
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00171')
      RETURN
      END
      SUBROUTINE S00172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00212,C00213,C00217,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00212(SSZ(2),SSZ(1))
      REAL C00213(SSZ(1))
      REAL C00217(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SM_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00212(I00001,I00003)
      RS2=C00213(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00217(I00001,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SM_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00172')
      RETURN
      END
      SUBROUTINE S00173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00218,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00218(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00004=1,SSZ(3)
      RS1=0.0
      DO 2 I00008=1,SSZ(1)
      RS2=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=RS2+C00049(SSMP(SSMPST(1)-1+I00004),I00008,I00003)
    3 CONTINUE
      RS1=RS1+RS2+C00050(I00004,I00008)
    2 CONTINUE
      DO 4 I00002=1,SSZ(1)
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=RS3+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
    5 CONTINUE
      RS4=RS3+C00050(I00004,I00002)
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      C00218(SSMP(SSMPST(1)-1+I00004),I00002)=RS6
    4 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00173')
      RETURN
      END
      SUBROUTINE S00174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00218,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00218(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 2 I00008=1,SSZ(1)
      RS2=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=RS2+C00049(SSMP(SSMPST(2)-1+I00001),I00008,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      DO 4 I00002=1,SSZ(1)
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=RS3+C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    5 CONTINUE
      RS4=RS3
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      C00218(SSMP(SSMPST(2)-1+I00001),I00002)=RS6
    4 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00174')
      RETURN
      END
      SUBROUTINE S00175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00008
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00219(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00008=1,SSZ(2)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS3=0.0
      DO 3 I00003=1,SSZ(1)
      RS3=RS3+C00049(I00008,I00002,I00003)
    3 CONTINUE
      RS2=RS2+RS3
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      RS4=0.0
      DO 4 I00009=1,SSZ(3)
      RS5=0.0
      DO 5 I00002=1,SSZ(1)
      RS5=RS5+C00050(I00009,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    4 CONTINUE
      DO 6 I00004=1,SSZ(3)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)
      RS7=0.0
      DO 8 I00003=1,SSZ(1)
      RS7=RS7+C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
    8 CONTINUE
      RS6=RS6+RS7+C00050(I00004,I00002)
    7 CONTINUE
      RS8=RS6
      RS9=RS1+RS4
      IF(RS9.NE.0.0) THEN
        RS10=RS8/RS9
      ELSE
        RS10=1.0
        IER=2
      END IF
      C00219(SSMP(SSMPST(1)-1+I00004))=RS10
    6 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00175')
      RETURN
      END
      SUBROUTINE S00176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00050,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00219(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00008=1,SSZ(2)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS3=0.0
      DO 3 I00003=1,SSZ(1)
      RS3=RS3+C00049(I00008,I00002,I00003)
    3 CONTINUE
      RS2=RS2+RS3
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      RS4=0.0
      DO 4 I00009=1,SSZ(3)
      RS5=0.0
      DO 5 I00002=1,SSZ(1)
      RS5=RS5+C00050(I00009,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    4 CONTINUE
      DO 6 I00001=1,SSZ(4)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)
      RS7=0.0
      DO 8 I00003=1,SSZ(1)
      RS7=RS7+C00049(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    8 CONTINUE
      RS6=RS6+RS7
    7 CONTINUE
      RS8=RS6
      RS9=RS1+RS4
      IF(RS9.NE.0.0) THEN
        RS10=RS8/RS9
      ELSE
        RS10=1.0
        IER=2
      END IF
      C00219(SSMP(SSMPST(2)-1+I00001))=RS10
    6 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00176')
      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 GTAPM_c5
      USE GTAPM_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,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(891).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
      CALL S00143(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(891),
     *  C00154,C00191,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(895).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
      CALL S00144(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(895),
     *  C00155,C00192,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(899).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
      CALL S00145(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(899),
     *  C00156,C00193,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VPAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      CALL S00146(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(905),
     *  C00057,C00194,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(909).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAREGEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00147(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(909),
     *  C00194,C00195,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(911).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CONSHREV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00148(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(911),
     *  C00194,C00195,C00196,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(913).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EYEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00149(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(913),
     *  C00082,C00095,C00196,C00197,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(916).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UELASPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00150(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(916),
     *  C00082,C00196,C00198,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(919).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XWCONSHREV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00151(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(919),
     *  C00082,C00196,C00198,C00199,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(923).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
      CALL S00152(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(923),
     *  C00058,C00200,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(927).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
      CALL S00153(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(927),
     *  C00056,C00201,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(931).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
      CALL S00154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(931),
     *  C00008,C00202,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(935).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00155(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(935),
     *  C00190,C00200,C00203,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(937).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRGOVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(937),
     *  C00190,C00201,C00204,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(939).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRSAVEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(939),
     *  C00190,C00202,C00205,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(948).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
      CALL S00158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(948),
     *  C00150,C00206,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(957).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EVSCALFACT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(957),
     *  C00059,C00150,C00190,C00206,C00207,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(959).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(959),
     *  C00128,C00208,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(1073).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1073),
     *  C00049,C00050,C00209,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1074).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1074),
     *  C00049,C00209,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1077).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SXT_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1077),
     *  C00049,C00050,C00210,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1079).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTICOMM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1079),
     *  C00128,C00211,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1081).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1081),
     *  C00049,C00211,C00212,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1082).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1082),
     *  C00049,C00212,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1084).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDATOT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1084),
     *  C00212,C00213,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1086).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1086),
     *  C00049,C00212,C00214,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1088).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SMT_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1088),
     *  C00211,C00212,C00215,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1090).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1090),
     *  C00049,C00050,C00216,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1091).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1091),
     *  C00049,C00050,C00216,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1093).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1093),
     *  C00212,C00213,C00217,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1095).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1095),
     *  C00049,C00050,C00218,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1096).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1096),
     *  C00049,C00218,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1098).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1098),
     *  C00049,C00050,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1099).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S00176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1099),
     *  C00049,C00050,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00009),C00009,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00010),C00010,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00011),C00011,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00012),C00012,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(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(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(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(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(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(C00043),C00043,
     *  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(C00044),C00044,
     *  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(C00045),C00045,
     *  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(C00046),C00046,
     *  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(C00047),C00047,
     *  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(C00048),C00048,
     *  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(C00049),C00049,
     *  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(C00050),C00050,
     *  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(C00117),C00117,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00128),C00128,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00006')
      RETURN
      END
      SUBROUTINE S00178(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(1))
      REAL C00056(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "GPRICEINDEX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      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(       87)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      RS1=-C00055(I00001,I00002)
      RS2=C00056(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(1),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "GPRICEINDEX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00178')
      RETURN
      END
      SUBROUTINE S00191(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=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(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(5),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00191')
      RETURN
      END
      SUBROUTINE S00192(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(1  -C00088(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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00192')
      RETURN
      END
      SUBROUTINE S00195(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00195')
      RETURN
      END
      SUBROUTINE S00196(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00001)))+SSZ(9)*(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
      END IF
      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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00196')
      RETURN
      END
      SUBROUTINE S00197(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00089(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHDPRICE3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      ENTRY=-C00089(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    3 CONTINUE
      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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHDPRICE3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00197')
      RETURN
      END
      SUBROUTINE S00203(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(9),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00203')
      RETURN
      END
      SUBROUTINE S00204(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00090(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(1  -C00090(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(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(9),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00204')
      RETURN
      END
      SUBROUTINE S00207(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(10),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00207')
      RETURN
      END
      SUBROUTINE S00208(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(10),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00208')
      RETURN
      END
      SUBROUTINE S00209(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00091(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHIPRICES3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      ENTRY=-C00091(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(11),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHIPRICES3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00209')
      RETURN
      END
      SUBROUTINE S00212(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00092,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgda"',
     *  ' in equation "GCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgda',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        3)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(1  -C00092(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(3),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(12),COLBF(3),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgda"',
     *  ' in equation "GCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00212')
      RETURN
      END
      SUBROUTINE S00219(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(14),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00219')
      RETURN
      END
      SUBROUTINE S00220(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00084(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(14),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00220')
      RETURN
      END
      SUBROUTINE S00221(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00084(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(14),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00221')
      RETURN
      END
      SUBROUTINE S00222(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgmb"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgmb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       15)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(14),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgmb"',
     *  ' in equation "GHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00222')
      RETURN
      END
      SUBROUTINE S00223(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "GHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(15),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "GHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00223')
      RETURN
      END
      SUBROUTINE S00224(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgmb"',
     *  ' in equation "GHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgmb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       15)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(15),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgmb"',
     *  ' in equation "GHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00224')
      RETURN
      END
      SUBROUTINE S00225(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "GHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(16),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "GHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00225')
      RETURN
      END
      SUBROUTINE S00226(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00084(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(16),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgmf"',
     *  ' in equation "GHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00226')
      RETURN
      END
      SUBROUTINE S00229(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "argd"',
     *  ' in equation "GHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'argd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00084(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(16),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "argd"',
     *  ' in equation "GHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00229')
      RETURN
      END
      SUBROUTINE M00007(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 GTAPM_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''',
     *    'GPRICEINDEX',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(1),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00178(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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(65),ECHO1,
     *  ROWBF(2),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(68),ECHO1,
     *  ROWBF(2),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(2),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(2),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(2),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(65),ECHO1,
     *  ROWBF(3),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(68),ECHO1,
     *  ROWBF(3),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(69),ECHO1,
     *  ROWBF(3),COLBF(69),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(3),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHDPRICE',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(3),ECHO1,
     *  ROWBF(4),COLBF(3),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(5),ECHO1,
     *  ROWBF(4),COLBF(5),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(4),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHDPRICE1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00191(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00192(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(8),ECHO1,
     *  ROWBF(5),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00088,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(91),ECHO1,
     *  ROWBF(5),COLBF(91),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00088,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHDPRICE2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00195(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00196(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'GHHDPRICE3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00197(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(8),ECHO1,
     *  ROWBF(7),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(92),ECHO1,
     *  ROWBF(7),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00089,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHIPRICES',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(11),ECHO1,
     *  ROWBF(8),COLBF(11),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(13),ECHO1,
     *  ROWBF(8),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(90),ECHO1,
     *  ROWBF(8),COLBF(90),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHIPRICES1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00203(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00204(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(16),ECHO1,
     *  ROWBF(9),COLBF(16),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00090,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(91),ECHO1,
     *  ROWBF(9),COLBF(91),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00090,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHIPRICES2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00207(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00208(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'GHHIPRICES3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00209(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(16),ECHO1,
     *  ROWBF(11),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(92),ECHO1,
     *  ROWBF(11),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00091,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GCOMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00212(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(3),KZC,DOEQ,STRHS,STRHNZ,
     *  C00092,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(11),ECHO1,
     *  ROWBF(12),COLBF(11),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00092,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(12),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHLDAGRIMP',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(11),ECHO1,
     *  ROWBF(13),COLBF(11),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(13),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(13),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(13),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHLDAGRIMP1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00219(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00220(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00221(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00222(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'GHHLDAGRIMP2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00223(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00224(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'GHHLDAGRIMP3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00225(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00226(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(16),ECHO1,
     *  ROWBF(16),COLBF(16),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00084,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(17),ECHO1,
     *  ROWBF(16),COLBF(17),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00229(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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('M00007')
      RETURN
      END
      SUBROUTINE S00230(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00085(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00085(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(17),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00230')
      RETURN
      END
      SUBROUTINE S00234(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00085(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "angd"',
     *  ' in equation "GHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'angd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       92)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00085(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(17),COLBF(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "angd"',
     *  ' in equation "GHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00234')
      RETURN
      END
      SUBROUTINE S00239(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00239')
      RETURN
      END
      SUBROUTINE S00240(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00084(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00240')
      RETURN
      END
      SUBROUTINE S00241(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00084(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00241')
      RETURN
      END
      SUBROUTINE S00242(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdb"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        7)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(7),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(7),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdb"',
     *  ' in equation "GHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00242')
      RETURN
      END
      SUBROUTINE S00243(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "GHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "GHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00243')
      RETURN
      END
      SUBROUTINE S00244(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdb"',
     *  ' in equation "GHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        7)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(7),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(7),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdb"',
     *  ' in equation "GHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00244')
      RETURN
      END
      SUBROUTINE S00245(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "GHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(21),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "GHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00245')
      RETURN
      END
      SUBROUTINE S00246(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pgdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00084(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(21),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pgdf"',
     *  ' in equation "GHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00246')
      RETURN
      END
      SUBROUTINE S00249(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "argd"',
     *  ' in equation "GHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'argd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00084(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(21),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "argd"',
     *  ' in equation "GHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00249')
      RETURN
      END
      SUBROUTINE S00250(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00085(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00085(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00250')
      RETURN
      END
      SUBROUTINE S00254(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00085(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "angd"',
     *  ' in equation "GHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'angd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       92)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00085(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "angd"',
     *  ' in equation "GHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00254')
      RETURN
      END
      SUBROUTINE S00260(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrgc"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrgc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       79)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(79),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(23),COLBF(79),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrgc"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00260')
      RETURN
      END
      SUBROUTINE S00270(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00093,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00093(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "UTILELASPRIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       73)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00093(I00001,I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "UTILELASPRIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00270')
      RETURN
      END
      SUBROUTINE S00273(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00097(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0+C00097(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00273')
      RETURN
      END
      SUBROUTINE M00008(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 GTAPM_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''',
     *    'GHHLDAGRIMP4',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00230(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(16),ECHO1,
     *  ROWBF(17),COLBF(16),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00085,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(17),ECHO1,
     *  ROWBF(17),COLBF(17),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(18),ECHO1,
     *  ROWBF(17),COLBF(18),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00234(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    '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(3),ECHO1,
     *  ROWBF(18),COLBF(3),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(4),ECHO1,
     *  ROWBF(18),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(18),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(18),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHLDDOM1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00239(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00240(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00241(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00242(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(7),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'GHHLDDOM2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00243(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00244(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(7),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'GHHLDDOM3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00245(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00246(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(8),ECHO1,
     *  ROWBF(21),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00084,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(21),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00249(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'GHHLDDOM4',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00250(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(8),ECHO1,
     *  ROWBF(22),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00085,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(22),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(10),ECHO1,
     *  ROWBF(22),COLBF(10),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00254(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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(23),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00060,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(5),ECHO1,
     *  ROWBF(23),COLBF(5),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00060,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(23),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00061,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(13),ECHO1,
     *  ROWBF(23),COLBF(13),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00061,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(23),COLBF(64),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00260(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(79),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(23),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00009,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(90),ECHO1,
     *  ROWBF(23),COLBF(90),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00014,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(71),ECHO1,
     *  ROWBF(24),COLBF(71),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(24),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00081,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVATEU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(65),ECHO1,
     *  ROWBF(25),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(71),ECHO1,
     *  ROWBF(25),COLBF(71),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(73),ECHO1,
     *  ROWBF(25),COLBF(73),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(74),ECHO1,
     *  ROWBF(25),COLBF(74),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00083,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(72),ECHO1,
     *  ROWBF(26),COLBF(72),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00270(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(73),KZC,DOEQ,STRHS,STRHNZ,
     *  C00093,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(26),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00093,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(26),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00093,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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 S00273(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(73),ECHO1,
     *  ROWBF(27),COLBF(73),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00097,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(27),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(2),SSZ(1),1,1,1,1,C00098,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(27),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHDPRICE',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(28),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(21),ECHO1,
     *  ROWBF(28),COLBF(21),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(28),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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('M00008')
      RETURN
      END
      SUBROUTINE S00294(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrpc"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrpc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       80)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(80),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(32),COLBF(80),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrpc"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00294')
      RETURN
      END
      SUBROUTINE S00297(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppda"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppda',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       19)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(1  -C00099(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(19),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(33),COLBF(19),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppda"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00297')
      RETURN
      END
      SUBROUTINE S00308(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00100,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(1  -C00100(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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(36),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00308')
      RETURN
      END
      SUBROUTINE S00309(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(36),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00309')
      RETURN
      END
      SUBROUTINE S00312(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00001)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00312')
      RETURN
      END
      SUBROUTINE S00313(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00313')
      RETURN
      END
      SUBROUTINE S00314(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00101(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHDPRICE3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      ENTRY=-C00101(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(38),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHDPRICE3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00314')
      RETURN
      END
      SUBROUTINE S00317(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00086(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00317')
      RETURN
      END
      SUBROUTINE S00318(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00318')
      RETURN
      END
      SUBROUTINE S00319(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00086(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00319')
      RETURN
      END
      SUBROUTINE S00320(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdb"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdb"',
     *  ' in equation "PHHLDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00320')
      RETURN
      END
      SUBROUTINE S00321(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "PHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "PHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00321')
      RETURN
      END
      SUBROUTINE S00322(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdb"',
     *  ' in equation "PHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdb"',
     *  ' in equation "PHHLDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00322')
      RETURN
      END
      SUBROUTINE S00323(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "PHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "PHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00323')
      RETURN
      END
      SUBROUTINE S00324(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00086(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppdf"',
     *  ' in equation "PHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00324')
      RETURN
      END
      SUBROUTINE S00327(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arpd"',
     *  ' in equation "PHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      100)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00086(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arpd"',
     *  ' in equation "PHHLDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00327')
      RETURN
      END
      SUBROUTINE S00328(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00087(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00328')
      RETURN
      END
      SUBROUTINE S00332(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anpd"',
     *  ' in equation "PHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00087(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anpd"',
     *  ' in equation "PHHLDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00332')
      RETURN
      END
      SUBROUTINE M00009(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 GTAPM_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TPDSHIFT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(95),ECHO1,
     *  ROWBF(29),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(29),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(29),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHIPRICES',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(26),ECHO1,
     *  ROWBF(30),COLBF(26),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(30),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(30),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(95),ECHO1,
     *  ROWBF(31),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(31),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(31),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(20),ECHO1,
     *  ROWBF(32),COLBF(20),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(21),ECHO1,
     *  ROWBF(32),COLBF(21),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(27),ECHO1,
     *  ROWBF(32),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00064,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(32),COLBF(28),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00064,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(32),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00065,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00294(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(80),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(32),COLBF(97),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00019,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(32),COLBF(98),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00024,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PCOMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00297(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(19),KZC,DOEQ,STRHS,STRHNZ,
     *  C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(26),ECHO1,
     *  ROWBF(33),COLBF(26),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00099,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(33),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHLDDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(19),ECHO1,
     *  ROWBF(34),COLBF(19),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(20),ECHO1,
     *  ROWBF(34),COLBF(20),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(34),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(34),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHLDAGRIMP',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(26),ECHO1,
     *  ROWBF(35),COLBF(26),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(27),ECHO1,
     *  ROWBF(35),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(35),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(35),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHDPRICE1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00308(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00100,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00309(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(23),ECHO1,
     *  ROWBF(36),COLBF(23),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00100,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(36),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00100,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHDPRICE2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00312(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00313(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHDPRICE3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00314(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(23),ECHO1,
     *  ROWBF(38),COLBF(23),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(38),COLBF(101),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00101,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHLDDOM1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00317(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00318(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00319(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00320(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHLDDOM2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00321(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00322(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHLDDOM3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00323(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00324(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(23),ECHO1,
     *  ROWBF(41),COLBF(23),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00086,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(24),ECHO1,
     *  ROWBF(41),COLBF(24),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00327(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHLDDOM4',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00328(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(23),ECHO1,
     *  ROWBF(42),COLBF(23),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00087,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(24),ECHO1,
     *  ROWBF(42),COLBF(24),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(25),ECHO1,
     *  ROWBF(42),COLBF(25),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00332(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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('M00009')
      RETURN
      END
      SUBROUTINE S00333(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(1  -C00102(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(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00333')
      RETURN
      END
      SUBROUTINE S00334(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppmf',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)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00334')
      RETURN
      END
      SUBROUTINE S00337(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(44),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00337')
      RETURN
      END
      SUBROUTINE S00338(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppmf',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)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(44),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00338')
      RETURN
      END
      SUBROUTINE S00339(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00103(SSZ(4),SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHIPRICES3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      ENTRY=-C00103(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHIPRICES3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00339')
      RETURN
      END
      SUBROUTINE S00342(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00086(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(46),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00342')
      RETURN
      END
      SUBROUTINE S00343(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(46),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00343')
      RETURN
      END
      SUBROUTINE S00344(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00086(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(46),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00344')
      RETURN
      END
      SUBROUTINE S00345(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpmb"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpmb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(46),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpmb"',
     *  ' in equation "PHHLDAGRIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00345')
      RETURN
      END
      SUBROUTINE S00346(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "PHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "PHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00346')
      RETURN
      END
      SUBROUTINE S00347(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpmb"',
     *  ' in equation "PHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpmb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpmb"',
     *  ' in equation "PHHLDAGRIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00347')
      RETURN
      END
      SUBROUTINE S00348(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "PHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "PHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00348')
      RETURN
      END
      SUBROUTINE S00349(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00086(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ppmf"',
     *  ' in equation "PHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00349')
      RETURN
      END
      SUBROUTINE S00352(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arpd"',
     *  ' in equation "PHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      100)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00086(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arpd"',
     *  ' in equation "PHHLDAGRIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00352')
      RETURN
      END
      SUBROUTINE S00353(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00087(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00353')
      RETURN
      END
      SUBROUTINE S00357(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anpd"',
     *  ' in equation "PHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(C00087(I00001)-1.0)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anpd"',
     *  ' in equation "PHHLDAGRIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00357')
      RETURN
      END
      SUBROUTINE S00366(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00104(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       33)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-C00104(I00005)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00005)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(33),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),COLBF(33),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00366')
      RETURN
      END
      SUBROUTINE S00367(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00005)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00367')
      RETURN
      END
      SUBROUTINE S00370(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00104(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ao"',
     *  ' in equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ao',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-(-1.0+C00104(I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ao"',
     *  ' in equation "VADEMAND"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00104(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ava"',
     *  ' in equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ava',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      107)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-(-1.0+C00104(I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),COLBF(107),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ava"',
     *  ' in equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00371')
      RETURN
      END
      SUBROUTINE S00377(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00104(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "INTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       33)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00104(I00005)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00005)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(33),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),COLBF(33),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "INTDEMAND"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "INTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00005)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "INTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00378')
      RETURN
      END
      SUBROUTINE S00381(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00104(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ao"',
     *  ' in equation "INTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ao',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(-1.0+C00104(I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ao"',
     *  ' in equation "INTDEMAND"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00104(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "af"',
     *  ' in equation "INTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'af',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(-1.0+C00104(I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "af"',
     *  ' in equation "INTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00382')
      RETURN
      END
      SUBROUTINE M00010(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 GTAPM_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''',
     *    'PHHIPRICES1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00333(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00334(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(30),ECHO1,
     *  ROWBF(43),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00102,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(43),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),1,1,1,1,1,C00102,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHIPRICES2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00337(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00338(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHIPRICES3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00339(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(30),ECHO1,
     *  ROWBF(45),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(45),COLBF(101),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00103,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHLDAGRIMP1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00342(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00343(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00344(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00345(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHLDAGRIMP2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00346(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00347(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHLDAGRIMP3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00348(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00349(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(30),ECHO1,
     *  ROWBF(48),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00086,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(48),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00352(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'PHHLDAGRIMP4',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00353(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(30),ECHO1,
     *  ROWBF(49),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00087,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(49),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(32),ECHO1,
     *  ROWBF(49),COLBF(32),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00357(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'AOWORLD',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(106),ECHO1,
     *  ROWBF(50),COLBF(106),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(50),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(112),ECHO1,
     *  ROWBF(50),COLBF(112),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(113),ECHO1,
     *  ROWBF(50),COLBF(113),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'AVAWORLD',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(107),ECHO1,
     *  ROWBF(51),COLBF(107),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(51),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(51),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(51),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VADEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00366(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(33),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00367(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(52),COLBF(102),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),1,1,1,1,1,1,C00104,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(103),ECHO1,
     *  ROWBF(52),COLBF(103),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00370(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'AFWORLD',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(108),ECHO1,
     *  ROWBF(53),COLBF(108),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(117),ECHO1,
     *  ROWBF(53),COLBF(117),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(118),ECHO1,
     *  ROWBF(53),COLBF(118),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(53),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(53),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INTDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00377(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(33),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(54),COLBF(104),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),1,1,1,1,1,1,C00104,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(105),ECHO1,
     *  ROWBF(54),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00381(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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('M00010')
      RETURN
      END
      SUBROUTINE S00386(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00107,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "DMNDDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(1  -C00107(I00001,I00005,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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(56),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "DMNDDPRICE1"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfdf"',
     *  ' in equation "DMNDDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       39)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(39),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(56),COLBF(39),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfdf"',
     *  ' in equation "DMNDDPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00387')
      RETURN
      END
      SUBROUTINE S00390(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "DMNDDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00001)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "DMNDDPRICE2"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfdf"',
     *  ' in equation "DMNDDPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       39)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(39),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),COLBF(39),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfdf"',
     *  ' in equation "DMNDDPRICE2"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00108,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00108(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "DMNDDPRICE3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(3)
      ENTRY=-C00108(I00001,I00004,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(58),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "DMNDDPRICE3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00392')
      RETURN
      END
      SUBROUTINE S00398(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00109,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00109(SSZ(4),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "DMNDIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(1  -C00109(I00001,I00005,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(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "DMNDIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00398')
      RETURN
      END
      SUBROUTINE S00399(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfmf"',
     *  ' in equation "DMNDIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       47)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(47),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),COLBF(47),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfmf"',
     *  ' in equation "DMNDIPRICES1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00399')
      RETURN
      END
      SUBROUTINE S00402(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "DMNDIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "DMNDIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00402')
      RETURN
      END
      SUBROUTINE S00403(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfmf"',
     *  ' in equation "DMNDIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       47)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(47),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(47),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfmf"',
     *  ' in equation "DMNDIPRICES2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00403')
      RETURN
      END
      SUBROUTINE S00404(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(3),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "DMNDIPRICES3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(3)
      ENTRY=-C00110(I00001,I00004,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(62),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "DMNDIPRICES3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00404')
      RETURN
      END
      SUBROUTINE S00412(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxriu"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxriu',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       81)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(81),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),COLBF(81),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxriu"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00412')
      RETURN
      END
      SUBROUTINE S00415(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00111(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfda"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfda',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       37)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(1  -C00111(I00001,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(37),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(64),COLBF(37),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfda"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00415')
      RETURN
      END
      SUBROUTINE S00422(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00105(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00422')
      RETURN
      END
      SUBROUTINE S00423(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00423')
      RETURN
      END
      SUBROUTINE S00424(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfmf"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       47)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00105(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(47),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(47),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfmf"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00424')
      RETURN
      END
      SUBROUTINE S00425(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfmb"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfmb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       48)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(48),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(48),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfmb"',
     *  ' in equation "INDIMP1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00425')
      RETURN
      END
      SUBROUTINE S00426(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "INDIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "INDIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00426')
      RETURN
      END
      SUBROUTINE S00427(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfmb"',
     *  ' in equation "INDIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfmb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       48)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(48),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(48),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfmb"',
     *  ' in equation "INDIMP2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00427')
      RETURN
      END
      SUBROUTINE S00432(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00105(I00001)
      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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00432')
      RETURN
      END
      SUBROUTINE S00433(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00433')
      RETURN
      END
      SUBROUTINE S00434(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfdf"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       39)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00105(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(39),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(39),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfdf"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00434')
      RETURN
      END
      SUBROUTINE S00435(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdb"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       40)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(40),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(40),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdb"',
     *  ' in equation "INDDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00435')
      RETURN
      END
      SUBROUTINE M00011(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 GTAPM_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''',
     *    'DMNDDPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(37),ECHO1,
     *  ROWBF(55),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(55),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(55),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DMNDDPRICE1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00386(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00107,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(39),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(41),ECHO1,
     *  ROWBF(56),COLBF(41),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(7),SSZ(1),1,1,1,1,C00107,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(56),COLBF(122),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(7),SSZ(1),1,1,1,1,C00107,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DMNDDPRICE2',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,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(39),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'DMNDDPRICE3',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,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00108,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(41),ECHO1,
     *  ROWBF(58),COLBF(41),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(58),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(7),SSZ(1),1,1,1,C00108,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DMNDIPRICES',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(59),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(47),ECHO1,
     *  ROWBF(59),COLBF(47),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(59),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DMNDIPRICES1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00398(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00109,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00399(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(47),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(60),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(7),SSZ(1),1,1,1,1,C00109,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(60),COLBF(122),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(7),SSZ(1),1,1,1,1,C00109,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DMNDIPRICES2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00402(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00403(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(47),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'DMNDIPRICES3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00404(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(62),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(62),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(7),SSZ(1),1,1,1,C00110,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(38),ECHO1,
     *  ROWBF(63),COLBF(38),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00066,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(63),COLBF(39),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00066,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(63),COLBF(45),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00067,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(47),ECHO1,
     *  ROWBF(63),COLBF(47),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00067,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(63),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00068,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,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,
     *  KSTEP,SMND(81),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(121),ECHO1,
     *  ROWBF(63),COLBF(121),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00031,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(63),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ICOMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00415(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(37),KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(64),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00111,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(104),ECHO1,
     *  ROWBF(64),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INDIMP',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(65),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(65),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(104),ECHO1,
     *  ROWBF(65),COLBF(104),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(105),ECHO1,
     *  ROWBF(65),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INDIMP1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00422(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00423(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00424(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(47),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00425(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(48),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'INDIMP2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00426(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00427(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(48),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(37),ECHO1,
     *  ROWBF(68),COLBF(37),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(68),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(104),ECHO1,
     *  ROWBF(68),COLBF(104),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(105),ECHO1,
     *  ROWBF(68),COLBF(105),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INDDOM1',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,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00433(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00434(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(39),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00435(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(40),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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('M00011')
      RETURN
      END
      SUBROUTINE S00436(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "INDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "INDDOM2"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdb"',
     *  ' in equation "INDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       40)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(40),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(40),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdb"',
     *  ' in equation "INDDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00437')
      RETURN
      END
      SUBROUTINE S00438(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "INDIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(71),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "INDIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00438')
      RETURN
      END
      SUBROUTINE S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfmf"',
     *  ' in equation "INDIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfmf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       47)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00105(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(47),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(71),COLBF(47),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfmf"',
     *  ' in equation "INDIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00439')
      RETURN
      END
      SUBROUTINE S00442(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arfd"',
     *  ' in equation "INDIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      122)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(-1.0+C00105(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(122),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(71),COLBF(122),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arfd"',
     *  ' in equation "INDIMP3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00442')
      RETURN
      END
      SUBROUTINE S00443(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "INDIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00106(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(72),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "INDIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00443')
      RETURN
      END
      SUBROUTINE S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anfd"',
     *  ' in equation "INDIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(-1.0+C00106(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00005-1+SSZ(7)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(72),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anfd"',
     *  ' in equation "INDIMP4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00447')
      RETURN
      END
      SUBROUTINE S00448(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "INDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(73),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "INDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00448')
      RETURN
      END
      SUBROUTINE S00449(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfdf"',
     *  ' in equation "INDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfdf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       39)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00105(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(39),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(73),COLBF(39),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfdf"',
     *  ' in equation "INDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00449')
      RETURN
      END
      SUBROUTINE S00452(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00105(SSZ(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arfd"',
     *  ' in equation "INDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      122)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(-1.0+C00105(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(122),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(73),COLBF(122),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arfd"',
     *  ' in equation "INDDOM3"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00452')
      RETURN
      END
      SUBROUTINE S00453(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00106(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(74),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00453')
      RETURN
      END
      SUBROUTINE S00457(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anfd"',
     *  ' in equation "INDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(-1.0+C00106(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00005-1+SSZ(7)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(74),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anfd"',
     *  ' in equation "INDDOM4"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00457')
      RETURN
      END
      SUBROUTINE S00458(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(75),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00458')
      RETURN
      END
      SUBROUTINE S00459(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfe"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       35)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(35),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(75),COLBF(35),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfe"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00459')
      RETURN
      END
      SUBROUTINE S00460(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tf"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      125)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(75),COLBF(125),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tf"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00460')
      RETURN
      END
      SUBROUTINE S00461(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfe"',
     *  ' in equation "SPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       35)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(35),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(76),COLBF(35),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfe"',
     *  ' in equation "SPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00461')
      RETURN
      END
      SUBROUTINE S00463(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tf"',
     *  ' in equation "SPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      125)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(76),COLBF(125),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tf"',
     *  ' in equation "SPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00463')
      RETURN
      END
      SUBROUTINE S00472(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(11)
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1+C00069(SSMP(SSMPST(11)-1+I00001),I00005,I00002)
    3 CONTINUE
      ENTRY=-RS1
      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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00472')
      RETURN
      END
      SUBROUTINE S00473(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(7)
      DO 3 I00001=1,SSZ(11)
      ENTRY=-C00069(SSMP(SSMPST(11)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00005-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
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00005=1,SSZ(7)
      DO 5 I00001=1,SSZ(10)
      ENTRY=-C00069(SSMP(SSMPST(10)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00473')
      RETURN
      END
      SUBROUTINE S00474(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pmes"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       46)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(10)
      ENTRY=-C00069(SSMP(SSMPST(10)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(10)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(46),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(46),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00474')
      RETURN
      END
      SUBROUTINE S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrfu"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrfu',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrfu"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00476')
      RETURN
      END
      SUBROUTINE S00477(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tf"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      125)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(7)
      DO 3 I00001=1,SSZ(11)
      ENTRY=-C00051(SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00005=1,SSZ(7)
      DO 5 I00001=1,SSZ(10)
      ENTRY=-C00051(SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(125),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tf"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00477')
      RETURN
      END
      SUBROUTINE S00482(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afe"',
     *  ' in equation "ENDWDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-(-1.0+C00115(I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(109),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(80),COLBF(109),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afe"',
     *  ' in equation "ENDWDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00482')
      RETURN
      END
      SUBROUTINE S00483(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(81),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00483')
      RETURN
      END
      SUBROUTINE S00484(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       33)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(33),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(81),COLBF(33),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00484')
      RETURN
      END
      SUBROUTINE S00485(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(81),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00485')
      RETURN
      END
      SUBROUTINE M00012(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GTAPM_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''',
     *    'INDDOM2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00436(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(40),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'INDIMP3',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00438(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(47),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(71),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00105,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(71),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00442(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(122),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'INDIMP4',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00443(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(72),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00106,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(72),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(72),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'INDDOM3',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,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00449(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(39),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(41),ECHO1,
     *  ROWBF(73),COLBF(41),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00105,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(73),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00452(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(122),KZC,DOEQ,STRHS,STRHNZ,
     *  C00105,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'INDDOM4',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00453(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(41),ECHO1,
     *  ROWBF(74),COLBF(41),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),1,1,1,1,1,1,C00106,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(74),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(74),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00457(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00458(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00459(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(35),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00460(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(125),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00461(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(35),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(46),ECHO1,
     *  ROWBF(76),COLBF(46),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00463(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(125),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'AFEWORLD',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(109),ECHO1,
     *  ROWBF(77),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(126),ECHO1,
     *  ROWBF(77),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(77),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(77),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(77),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VAPRICE',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(35),ECHO1,
     *  ROWBF(78),COLBF(35),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(7),SSZ(1),1,1,1,1,C00114,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(78),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(78),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(7),SSZ(1),1,1,1,1,C00114,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00472(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00473(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00474(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(46),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(79),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00070,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00477(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(125),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'ENDWDEMAND',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(35),ECHO1,
     *  ROWBF(80),COLBF(35),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),1,1,1,1,1,1,C00115,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(36),ECHO1,
     *  ROWBF(80),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(80),COLBF(102),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),1,1,1,1,1,1,C00115,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(103),ECHO1,
     *  ROWBF(80),COLBF(103),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00482(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00115,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00483(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00484(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(33),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00485(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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('M00012')
      RETURN
      END
      SUBROUTINE S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-C00071(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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(82),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00486')
      RETURN
      END
      SUBROUTINE S00487(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-C00071(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(82),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00487')
      RETURN
      END
      SUBROUTINE S00489(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=C00052(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(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(82),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00489')
      RETURN
      END
      SUBROUTINE S00490(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrout"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrout',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       83)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(82),COLBF(83),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrout"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00490')
      RETURN
      END
      SUBROUTINE S00491(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       33)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00005)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(33),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(33),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00491')
      RETURN
      END
      SUBROUTINE S00492(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfe"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       35)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(6)
      ENTRY=-C00116(SSMP(SSMPST(5)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(35),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(35),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfe"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00492')
      RETURN
      END
      SUBROUTINE S00493(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      104)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00116(SSMP(SSMPST(6)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(104),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(104),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00493')
      RETURN
      END
      SUBROUTINE S00495(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00116(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ava"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ava',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      107)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00001=1,SSZ(6)
      RS1=RS1-C00116(SSMP(SSMPST(5)-1+I00001),I00005,I00002)
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
      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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ava"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00495')
      RETURN
      END
      SUBROUTINE S00496(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "af"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'af',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(2)
      ENTRY=C00116(SSMP(SSMPST(6)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "af"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00496')
      RETURN
      END
      SUBROUTINE S00497(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afe"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(6)
      ENTRY=C00116(SSMP(SSMPST(5)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(109),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(109),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afe"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00497')
      RETURN
      END
      SUBROUTINE S00499(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "KAPSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00008=1,SSZ(12)
      RS1=RS1+C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00008))),I00002)
    2 CONTINUE
      DO 3 I00007=1,SSZ(12)
      RS2=-C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007))),I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      ENTRY=RS4
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(84),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "KAPSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00499')
      RETURN
      END
      SUBROUTINE S00501(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "KAPRENTAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       33)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00008=1,SSZ(12)
      RS1=RS1+C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00008))),I00002)
    2 CONTINUE
      DO 3 I00007=1,SSZ(12)
      RS2=-C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007))),I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      ENTRY=RS4
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(33),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),COLBF(33),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "KAPRENTAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00501')
      RETURN
      END
      SUBROUTINE S00503(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00078,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00078(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CAPGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00007=1,SSZ(5)
      RS1=-C00052(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
      RS2=C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(86),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CAPGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00503')
      RETURN
      END
      SUBROUTINE S00505(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00078,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00078(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "PRCGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       33)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00007=1,SSZ(5)
      RS1=-C00052(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
      RS2=C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(33),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),COLBF(33),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "PRCGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00505')
      RETURN
      END
      SUBROUTINE S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00118,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00118(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "KEND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(1.0-C00118(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(89),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "KEND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00509')
      RETURN
      END
      SUBROUTINE S00519(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "BALDWIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(12)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(92),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "BALDWIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00519')
      RETURN
      END
      SUBROUTINE S00522(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00079,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00079(SSZ(1))
      INTEGER C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-(1  -C00121(1))*C00046(I00002)
      RS2=C00079(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00522')
      RETURN
      END
      SUBROUTINE S00523(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "globalcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'globalcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(1  -C00121(1))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "globalcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00523')
      RETURN
      END
      SUBROUTINE S00524(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rore"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rore',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      133)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00121(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(133),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(133),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rore"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00524')
      RETURN
      END
      SUBROUTINE S00525(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(SSZ(1))
      INTEGER C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      135)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=(1  -C00121(1))*C00078(I00002)
      RS2=C00079(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(135),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(135),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00525')
      RETURN
      END
      SUBROUTINE S00526(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rorg"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rorg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      138)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00121(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(138),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(138),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rorg"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00526')
      RETURN
      END
      SUBROUTINE S00528(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00080,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00080(1)
      INTEGER C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=C00121(1)*C00046(I00002)
      RS2=C00080(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(94),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00528')
      RETURN
      END
      SUBROUTINE S00529(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "globalcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'globalcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      RWN=RWN+1
      ENTRY=C00121(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(94),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "globalcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00529')
      RETURN
      END
      SUBROUTINE S00530(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00080,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00079(SSZ(1))
      REAL C00080(1)
      INTEGER C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rore"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rore',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      133)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-(1  -C00121(1))*C00079(I00002)
      RS2=C00080(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(133),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(94),COLBF(133),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rore"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00530')
      RETURN
      END
      SUBROUTINE S00531(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00080,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00080(1)
      INTEGER C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      135)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-C00121(1)*C00078(I00002)
      RS2=C00080(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(135),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(94),COLBF(135),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00531')
      RETURN
      END
      SUBROUTINE S00532(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rorg"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rorg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      138)
      RWN=RWN+1
      ENTRY=1  -C00121(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(138),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(94),COLBF(138),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rorg"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00532')
      RETURN
      END
      SUBROUTINE S00533(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00080,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00079(SSZ(1))
      REAL C00080(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "PRICGDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-C00079(I00002)
      RS2=C00080(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(59),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(95),COLBF(59),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "PRICGDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00533')
      RETURN
      END
      SUBROUTINE S00536(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00079,C00080,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL C00079(SSZ(1))
      REAL C00080(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "SAVEPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(59),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 3 I00003=1,SSZ(1)
      RS1=-(C00079(I00003)-C00008(I00003))
      RS2=C00080(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(59),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(96),COLBF(59),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "SAVEPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00536')
      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 GTAPM_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''',
     *    'TOUTRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00487(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(82),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00072,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00489(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00490(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ZEROPROFITS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00491(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(33),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00492(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(35),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00493(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(104),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00495(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00496(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00497(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(130),ECHO1,
     *  ROWBF(83),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KAPSVCES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00499(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(84),COLBF(136),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00501(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(33),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(131),ECHO1,
     *  ROWBF(85),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00503(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00078,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(135),ECHO1,
     *  ROWBF(86),COLBF(135),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00505(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(33),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00078,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(87),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(58),ECHO1,
     *  ROWBF(88),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(88),COLBF(136),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00118,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(89),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(135),ECHO1,
     *  ROWBF(89),COLBF(135),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00118,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(59),ECHO1,
     *  ROWBF(90),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00119,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(131),ECHO1,
     *  ROWBF(90),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00119,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(134),ECHO1,
     *  ROWBF(90),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(58),ECHO1,
     *  ROWBF(91),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00120,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(132),ECHO1,
     *  ROWBF(91),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00120,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(133),ECHO1,
     *  ROWBF(91),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(134),ECHO1,
     *  ROWBF(91),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00519(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(135),ECHO1,
     *  ROWBF(92),COLBF(135),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(92),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'RORGLOBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00522(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00079,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(133),KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00525(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(135),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(138),KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(139),ECHO1,
     *  ROWBF(93),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00528(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00080,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00529(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00530(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(133),KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00080,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00531(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(135),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00080,C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(138),KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00533(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(59),KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00080,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(78),ECHO1,
     *  ROWBF(95),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(96),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00536(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(59),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00079,C00080,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(96),COLBF(140),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00013')
      RETURN
      END
      SUBROUTINE S00538(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00122(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "DMDMARGEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      DO     4 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00122(SSMP(SSMPST(2)-1+I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(97),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "DMDMARGEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00538')
      RETURN
      END
      SUBROUTINE S00540(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00122(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "prxd"',
     *  ' in equation "DMDMARGEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'prxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       53)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      DO     4 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00122(SSMP(SSMPST(2)-1+I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(4)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(53),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(97),COLBF(53),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "prxd"',
     *  ' in equation "DMDMARGEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00540')
      RETURN
      END
      SUBROUTINE S00542(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00122(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anxd"',
     *  ' in equation "DMDMARGEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      141)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      DO     4 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-(-1.0+C00122(SSMP(SSMPST(2)-1+I00005)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00005-1+SSZ(4)*(I00002-1+SSZ(1)*(I00003-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(141),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(97),COLBF(141),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anxd"',
     *  ' in equation "DMDMARGEXP"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "AMARGPEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(3)
      ENTRY=-C00124(I00004,I00005,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(98),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "AMARGPEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00543')
      RETURN
      END
      SUBROUTINE S00546(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "prxd"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'prxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       53)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00123(SSMP(SSMPST(2)-1+I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(4)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(53),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(99),COLBF(53),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "prxd"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00546')
      RETURN
      END
      SUBROUTINE S00548(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxfs"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxfs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00123(SSMP(SSMPST(2)-1+I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(99),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxfs"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00548')
      RETURN
      END
      SUBROUTINE S00549(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(99),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00549')
      RETURN
      END
      SUBROUTINE S00550(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arxd"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      142)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(-1.0+C00123(SSMP(SSMPST(2)-1+I00005)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(4)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(142),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(99),COLBF(142),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arxd"',
     *  ' in equation "AMARGQEXP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00550')
      RETURN
      END
      SUBROUTINE S00551(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EXPORTQTY1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00123(SSMP(SSMPST(2)-1+I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(100),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPORTQTY1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00551')
      RETURN
      END
      SUBROUTINE S00552(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxbs"',
     *  ' in equation "EXPORTQTY1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxbs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       55)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(55),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(100),COLBF(55),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxbs"',
     *  ' in equation "EXPORTQTY1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00552')
      RETURN
      END
      SUBROUTINE S00553(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxfs"',
     *  ' in equation "EXPORTQTY1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxfs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00123(SSMP(SSMPST(2)-1+I00005))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(100),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxfs"',
     *  ' in equation "EXPORTQTY1"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "EXPORTQTY1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(100),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "EXPORTQTY1"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxbs"',
     *  ' in equation "EXPORTQTY2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxbs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       55)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(55),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(101),COLBF(55),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxbs"',
     *  ' in equation "EXPORTQTY2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00555')
      RETURN
      END
      SUBROUTINE S00556(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "EXPORTQTY2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(101),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "EXPORTQTY2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00556')
      RETURN
      END
      SUBROUTINE S00557(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EXPORTPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-(1  -C00125(I00005,I00002,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPORTPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00557')
      RETURN
      END
      SUBROUTINE S00559(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxfs"',
     *  ' in equation "EXPORTPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxfs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxfs"',
     *  ' in equation "EXPORTPRICE1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00559')
      RETURN
      END
      SUBROUTINE S00561(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EXPORTPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(103),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPORTPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00561')
      RETURN
      END
      SUBROUTINE S00562(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxfs"',
     *  ' in equation "EXPORTPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxfs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(103),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxfs"',
     *  ' in equation "EXPORTPRICE2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00562')
      RETURN
      END
      SUBROUTINE S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrexp"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrexp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       84)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(84),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(105),COLBF(84),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrexp"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00570')
      RETURN
      END
      SUBROUTINE S00571(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      143)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00045(I00001,I00002,I00003)
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(143),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(105),COLBF(143),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00571')
      RETURN
      END
      SUBROUTINE S00580(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PRICETGT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PRICETGT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00580')
      RETURN
      END
      SUBROUTINE S00587(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00127(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(-1.0+C00127(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(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(109),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00587')
      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 GTAPM_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''',
     *    'DMDMARGEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00538(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(97),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,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,
     *  KSTEP,SMND(53),KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(54),ECHO1,
     *  ROWBF(97),COLBF(54),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00542(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(141),KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'AMARGPEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00543(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(98),COLBF(53),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(98),COLBF(141),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(4),SSZ(1),SSZ(1),1,1,1,C00124,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'AMARGQEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00546(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(53),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(54),ECHO1,
     *  ROWBF(99),COLBF(54),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00548(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00549(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00550(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(142),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'EXPORTQTY1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00551(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00552(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(55),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00553(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'EXPORTQTY2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00555(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(55),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00556(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'EXPORTPRICE1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00557(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(102),COLBF(53),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),SSZ(1),1,1,1,1,C00125,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00559(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(102),COLBF(142),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(1),SSZ(1),1,1,1,1,C00125,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EXPORTPRICE2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00561(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00562(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'EXPRICES',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(104),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(62),ECHO1,
     *  ROWBF(104),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(104),COLBF(143),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(104),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(105),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00073,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(105),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00073,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(105),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00074,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(84),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00571(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(143),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(105),COLBF(144),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00045,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTPRICES',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(106),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(106),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(106),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(146),ECHO1,
     *  ROWBF(106),COLBF(146),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(14),ECHO1,
     *  ROWBF(107),COLBF(14),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(60),ECHO1,
     *  ROWBF(107),COLBF(60),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00126,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(107),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00126,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00580(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(14),ECHO1,
     *  ROWBF(108),COLBF(14),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(108),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(14),ECHO1,
     *  ROWBF(109),COLBF(14),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00127,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(109),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(60),ECHO1,
     *  ROWBF(109),COLBF(60),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00127,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(76),ECHO1,
     *  ROWBF(109),COLBF(76),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00587(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00591(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrimp"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrimp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrimp"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00591')
      RETURN
      END
      SUBROUTINE S00592(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00047(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tm"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tm',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)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00047(I00001,I00003,I00002)
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),COLBF(145),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tm"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00592')
      RETURN
      END
      SUBROUTINE S00599(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PTRANSPORT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00135(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(113),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PTRANSPORT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00599')
      RETURN
      END
      SUBROUTINE S00605(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "TRANSTECHANGE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      150)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      DO     4 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(150),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(115),COLBF(150),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "TRANSTECHANGE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00605')
      RETURN
      END
      SUBROUTINE S00610(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TRANSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(116),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TRANSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00610')
      RETURN
      END
      SUBROUTINE S00617(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00617')
      RETURN
      END
      SUBROUTINE S00618(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       33)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(33),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),COLBF(33),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00618')
      RETURN
      END
      SUBROUTINE S00619(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00619')
      RETURN
      END
      SUBROUTINE S00620(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00071(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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(119),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00620')
      RETURN
      END
      SUBROUTINE S00621(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00071(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(119),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00621')
      RETURN
      END
      SUBROUTINE S00623(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=C00052(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(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(119),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00623')
      RETURN
      END
      SUBROUTINE S00624(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrinc"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       86)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(86),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(119),COLBF(86),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrinc"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00624')
      RETURN
      END
      SUBROUTINE S00625(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(120),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00625')
      RETURN
      END
      SUBROUTINE S00626(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00145,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00145(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       46)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(7)
      ENTRY=-C00145(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(46),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(120),COLBF(46),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00626')
      RETURN
      END
      SUBROUTINE S00627(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=-C00146(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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(121),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00627')
      RETURN
      END
      SUBROUTINE S00628(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(121),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00628')
      RETURN
      END
      SUBROUTINE S00631(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "endwslack"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'endwslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       67)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(67),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(121),COLBF(67),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "endwslack"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00631')
      RETURN
      END
      SUBROUTINE S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00054(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00054(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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(122),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00632')
      RETURN
      END
      SUBROUTINE S00633(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00054(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00054(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(122),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00633')
      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 GTAPM_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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(110),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00075,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(110),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00075,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(110),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00076,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00591(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00592(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(145),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(146),ECHO1,
     *  ROWBF(110),COLBF(146),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00047,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QTRANS_MFSD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(111),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(111),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(111),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(148),ECHO1,
     *  ROWBF(112),COLBF(148),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),SSZ(1),1,1,1,C00134,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(112),COLBF(156),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00599(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(113),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRANSCOSTINDEX',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(149),ECHO1,
     *  ROWBF(114),COLBF(149),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),SSZ(1),1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(155),ECHO1,
     *  ROWBF(114),COLBF(155),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(114),COLBF(157),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),SSZ(1),1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRANSTECHANGE',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(149),ECHO1,
     *  ROWBF(115),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00605(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(150),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(151),ECHO1,
     *  ROWBF(115),COLBF(151),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(152),ECHO1,
     *  ROWBF(115),COLBF(152),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(115),COLBF(153),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(115),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00610(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(116),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(116),COLBF(156),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(116),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FOBCIF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(61),ECHO1,
     *  ROWBF(117),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(117),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00139,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(155),ECHO1,
     *  ROWBF(117),COLBF(155),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00140,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00617(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00618(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(33),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00619(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00620(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00621(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(119),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00144,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00623(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00624(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(86),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00625(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00626(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(46),KZC,DOEQ,STRHS,STRHNZ,
     *  C00145,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00627(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00628(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(46),ECHO1,
     *  ROWBF(121),COLBF(46),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(10),1,1,1,1,1,1,C00146,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(121),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00631(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(67),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FACTORINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(122),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00046,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(122),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00046,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(122),COLBF(162),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00147,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(79),ECHO1,
     *  ROWBF(123),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(80),ECHO1,
     *  ROWBF(123),COLBF(80),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(81),ECHO1,
     *  ROWBF(123),COLBF(81),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(82),ECHO1,
     *  ROWBF(123),COLBF(82),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(123),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(123),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(123),COLBF(85),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(163),ECHO1,
     *  ROWBF(123),COLBF(163),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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('M00015')
      RETURN
      END
      SUBROUTINE S00654(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,C00148,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      REAL C00148(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "y"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'y',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       64)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00059(I00002)-C00148(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(64),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(125),COLBF(64),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "y"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00654')
      RETURN
      END
      SUBROUTINE S00656(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_indtaxr"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_indtaxr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      163)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-100.0 *C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(163),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(125),COLBF(163),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_indtaxr"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00656')
      RETURN
      END
      SUBROUTINE S00683(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "y"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'y',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       64)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-1.0
      RS2=C00150(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(64),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(64),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "y"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00683')
      RETURN
      END
      SUBROUTINE S00684(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=1.0
      RS2=C00150(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00684')
      RETURN
      END
      SUBROUTINE S00685(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00151(SSZ(1))
      REAL C00154(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      159)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00154(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00151(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(159),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(159),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00685')
      RETURN
      END
      SUBROUTINE S00686(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00155,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00152(SSZ(1))
      REAL C00155(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      160)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00155(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00152(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(160),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(160),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00686')
      RETURN
      END
      SUBROUTINE S00687(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00156,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00153(SSZ(1))
      REAL C00156(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      161)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00156(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00153(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(161),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(161),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00687')
      RETURN
      END
      SUBROUTINE S00690(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      170)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=1.0
      RS2=C00150(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(170),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(170),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "p"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00690')
      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 GTAPM_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''',
     *    '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(79),ECHO1,
     *  ROWBF(124),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(80),ECHO1,
     *  ROWBF(124),COLBF(80),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(81),ECHO1,
     *  ROWBF(124),COLBF(81),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(82),ECHO1,
     *  ROWBF(124),COLBF(82),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(124),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(124),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(124),COLBF(85),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(86),ECHO1,
     *  ROWBF(124),COLBF(86),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(164),ECHO1,
     *  ROWBF(124),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00654(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(64),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,C00148,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(125),COLBF(162),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00147,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00656(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(163),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(165),ECHO1,
     *  ROWBF(125),COLBF(165),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00059,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(159),ECHO1,
     *  ROWBF(126),COLBF(159),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00141,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(126),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00142,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(126),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00143,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(126),COLBF(166),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(72),ECHO1,
     *  ROWBF(127),COLBF(72),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00141,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(127),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(127),COLBF(166),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(64),ECHO1,
     *  ROWBF(128),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(72),ECHO1,
     *  ROWBF(128),COLBF(72),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(73),ECHO1,
     *  ROWBF(128),COLBF(73),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(128),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(128),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(64),ECHO1,
     *  ROWBF(129),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(69),ECHO1,
     *  ROWBF(129),COLBF(69),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(129),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(129),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(130),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(130),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(130),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(130),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(130),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRICEINDEXREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(131),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00143,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(68),ECHO1,
     *  ROWBF(131),COLBF(68),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00142,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(71),ECHO1,
     *  ROWBF(131),COLBF(71),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00141,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(131),COLBF(170),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILITY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00683(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(64),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00684(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00685(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(159),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00686(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(160),KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00155,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(161),KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00156,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(132),COLBF(167),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(132),COLBF(168),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00690(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(170),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    '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(159),ECHO1,
     *  ROWBF(133),COLBF(159),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00151,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(133),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00152,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(161),ECHO1,
     *  ROWBF(133),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00153,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(169),ECHO1,
     *  ROWBF(133),COLBF(169),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00149,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00016')
      RETURN
      END
      SUBROUTINE S00695(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00695')
      RETURN
      END
      SUBROUTINE S00696(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00159(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxbs"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxbs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       55)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00159(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(55),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(55),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxbs"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00696')
      RETURN
      END
      SUBROUTINE S00698(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00157,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00157(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      171)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00157(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(171),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(171),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00698')
      RETURN
      END
      SUBROUTINE S00699(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tradslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      172)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(172),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00699')
      RETURN
      END
      SUBROUTINE S00700(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(135),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00700')
      RETURN
      END
      SUBROUTINE S00701(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00159(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxbs"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxbs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       55)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00159(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(55),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(135),COLBF(55),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxbs"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00701')
      RETURN
      END
      SUBROUTINE S00702(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00157,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00157(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      171)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00157(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(171),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(135),COLBF(171),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00702')
      RETURN
      END
      SUBROUTINE S00703(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tradslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      172)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(172),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(135),COLBF(172),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00703')
      RETURN
      END
      SUBROUTINE S00708(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00166(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdb"',
     *  ' in equation "MKTCLDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        7)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00166(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(7),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(137),COLBF(7),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdb"',
     *  ' in equation "MKTCLDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00708')
      RETURN
      END
      SUBROUTINE S00709(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00165,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00165(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdb"',
     *  ' in equation "MKTCLDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00165(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(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(137),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdb"',
     *  ' in equation "MKTCLDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00709')
      RETURN
      END
      SUBROUTINE S00710(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00164,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00164(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdb"',
     *  ' in equation "MKTCLDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       40)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-C00164(SSMP(SSMPST(2)-1+I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(40),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(137),COLBF(40),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdb"',
     *  ' in equation "MKTCLDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00710')
      RETURN
      END
      SUBROUTINE S00711(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLDOM1"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      171)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(171),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(137),COLBF(171),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLDOM1"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00166(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdb"',
     *  ' in equation "MKTCLDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        7)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00166(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(7),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(7),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdb"',
     *  ' in equation "MKTCLDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00712')
      RETURN
      END
      SUBROUTINE S00715(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00165,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00165(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdb"',
     *  ' in equation "MKTCLDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00165(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdb"',
     *  ' in equation "MKTCLDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00715')
      RETURN
      END
      SUBROUTINE S00718(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00164,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00164(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdb"',
     *  ' in equation "MKTCLDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       40)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-C00164(SSMP(SSMPST(1)-1+I00004),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00005-1+SSZ(7)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(40),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(40),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdb"',
     *  ' in equation "MKTCLDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00718')
      RETURN
      END
      SUBROUTINE S00722(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLDOM2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      171)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(171),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(171),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLDOM2"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(139),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00723')
      RETURN
      END
      SUBROUTINE S00724(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00174,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00174(SSZ(11),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(11)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-C00174(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(139),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "MKTCLENDWM"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "endwslack"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'endwslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       67)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(67),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(139),COLBF(67),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "endwslack"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00725')
      RETURN
      END
      SUBROUTINE S00726(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00005-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(140),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00726')
      RETURN
      END
      SUBROUTINE S00737(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REALRETURN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REALRETURN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00737')
      RETURN
      END
      SUBROUTINE S00740(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00054(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PRIMFACTPR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00054(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(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(145),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PRIMFACTPR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00740')
      RETURN
      END
      SUBROUTINE S00744(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REGSUPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(3)
      ENTRY=-C00050(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REGSUPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00744')
      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 GTAPM_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLTRD_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00695(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00696(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(55),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(134),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00158,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00698(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(171),KZC,DOEQ,STRHS,STRHNZ,
     *  C00157,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00699(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(172),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00700(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00701(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(55),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00702(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(171),KZC,DOEQ,STRHS,STRHNZ,
     *  C00157,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00703(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(172),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(15),ECHO1,
     *  ROWBF(136),COLBF(15),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00163,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(136),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00162,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(136),COLBF(48),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00161,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(76),ECHO1,
     *  ROWBF(136),COLBF(76),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLDOM1',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00708(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(7),KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00709(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00165,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00710(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(40),KZC,DOEQ,STRHS,STRHNZ,
     *  C00164,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00711(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(171),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    'MKTCLDOM2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00712(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(7),KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(10),ECHO1,
     *  ROWBF(138),COLBF(10),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00169,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(18),ECHO1,
     *  ROWBF(138),COLBF(18),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00170,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00715(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00165,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(25),ECHO1,
     *  ROWBF(138),COLBF(25),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00167,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(32),ECHO1,
     *  ROWBF(138),COLBF(32),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(1),1,1,1,1,C00168,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00718(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(40),KZC,DOEQ,STRHS,STRHNZ,
     *  C00164,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(43),ECHO1,
     *  ROWBF(138),COLBF(43),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(7),SSZ(1),1,1,1,C00171,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(138),COLBF(51),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(7),SSZ(1),1,1,1,C00172,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(138),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(4),SSZ(1),SSZ(1),1,1,1,C00173,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00722(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(171),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00723(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00174,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00725(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(67),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00726(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(140),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_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(77),ECHO1,
     *  ROWBF(141),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(141),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(141),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WALRAS_D',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(142),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00008,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(142),COLBF(2),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00008,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(142),COLBF(174),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00080,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(173),ECHO1,
     *  ROWBF(143),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(143),COLBF(174),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(143),COLBF(175),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00737(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(71),ECHO1,
     *  ROWBF(144),COLBF(71),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(180),ECHO1,
     *  ROWBF(144),COLBF(180),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00740(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(181),ECHO1,
     *  ROWBF(145),COLBF(181),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(181),ECHO1,
     *  ROWBF(146),COLBF(181),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(182),ECHO1,
     *  ROWBF(146),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00180,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00744(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(62),ECHO1,
     *  ROWBF(147),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00049,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(183),ECHO1,
     *  ROWBF(147),COLBF(183),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00752(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(3)
      ENTRY=-C00050(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00752')
      RETURN
      END
      SUBROUTINE S00753(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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),SSZ(1))
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00049(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00048(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(57),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00753')
      RETURN
      END
      SUBROUTINE S00764(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(3)
      ENTRY=-C00050(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(151),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00764')
      RETURN
      END
      SUBROUTINE S00771(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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),SSZ(1))
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00049(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00048(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(57),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(152),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00771')
      RETURN
      END
      SUBROUTINE S00777(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "compvaladeq"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(153),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "compvaladeq"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00777')
      RETURN
      END
      SUBROUTINE S00780(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00050(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(154),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00780')
      RETURN
      END
      SUBROUTINE S00781(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(154),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00781')
      RETURN
      END
      SUBROUTINE S00782(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(154),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00782')
      RETURN
      END
      SUBROUTINE S00784(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      176)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00175(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(176),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(154),COLBF(176),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00784')
      RETURN
      END
      SUBROUTINE S00785(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00785')
      RETURN
      END
      SUBROUTINE S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(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(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00786')
      RETURN
      END
      SUBROUTINE S00787(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      176)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00175(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(176),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),COLBF(176),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00787')
      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 GTAPM_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''',
     *    'REGDEMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(61),ECHO1,
     *  ROWBF(148),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(184),ECHO1,
     *  ROWBF(148),COLBF(184),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00178,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(183),ECHO1,
     *  ROWBF(149),COLBF(183),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(149),COLBF(184),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(185),ECHO1,
     *  ROWBF(149),COLBF(185),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00752(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00753(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(150),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00078,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(150),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(150),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00049,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(150),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00050,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(150),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(150),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(150),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(150),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(135),ECHO1,
     *  ROWBF(150),COLBF(135),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00078,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(186),ECHO1,
     *  ROWBF(150),COLBF(186),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00181,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PGDP_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00764(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(151),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00078,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(151),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(151),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00049,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(151),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(151),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(187),ECHO1,
     *  ROWBF(151),COLBF(187),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00181,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00771(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(152),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00050,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(152),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(152),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(135),ECHO1,
     *  ROWBF(152),COLBF(135),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00078,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(152),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00181,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'compvaladeq',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00777(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(153),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(153),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00780(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00781(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00782(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(154),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00050,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00784(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(176),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00785(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00787(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(176),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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(176),ECHO1,
     *  ROWBF(156),COLBF(176),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00175,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(178),ECHO1,
     *  ROWBF(156),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(176),ECHO1,
     *  ROWBF(157),COLBF(176),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00175,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(191),ECHO1,
     *  ROWBF(157),COLBF(191),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00182,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(178),ECHO1,
     *  ROWBF(158),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(158),COLBF(192),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00183,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(159),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(159),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(177),ECHO1,
     *  ROWBF(159),COLBF(177),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00018')
      RETURN
      END
      SUBROUTINE S00801(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00186(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "VWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00186(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "VWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00801')
      RETURN
      END
      SUBROUTINE S00808(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      104)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      ENTRY=-C00051(SSMP(SSMPST(6)-1+I00001),I00005,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(104),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(163),COLBF(104),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00808')
      RETURN
      END
      SUBROUTINE S00809(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      ENTRY=-C00051(SSMP(SSMPST(6)-1+I00001),I00005,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(163),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00809')
      RETURN
      END
      SUBROUTINE S00811(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00050(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(164),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00811')
      RETURN
      END
      SUBROUTINE S00812(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(164),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00812')
      RETURN
      END
      SUBROUTINE S00813(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      190)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00175(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(190),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(164),COLBF(190),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00813')
      RETURN
      END
      SUBROUTINE S00814(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(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(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(165),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "PREGEX_ir_NMRG"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      190)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00175(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(190),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(165),COLBF(190),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00815')
      RETURN
      END
      SUBROUTINE S00832(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      104)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      ENTRY=-C00051(SSMP(SSMPST(6)-1+I00001),I00005,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(104),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(173),COLBF(104),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00832')
      RETURN
      END
      SUBROUTINE S00834(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(174),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00834')
      RETURN
      END
      SUBROUTINE S00836(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      204)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00175(SSMP(SSMPST(1)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(204),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(174),COLBF(204),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00836')
      RETURN
      END
      SUBROUTINE S00837(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00049(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(175),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00837')
      RETURN
      END
      SUBROUTINE S00838(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      204)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00175(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(204),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(175),COLBF(204),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00838')
      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 GTAPM_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''',
     *    '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(177),ECHO1,
     *  ROWBF(160),COLBF(177),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(160),COLBF(179),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VWLDIM_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(177),ECHO1,
     *  ROWBF(161),COLBF(177),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(161),COLBF(193),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00801(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(190),ECHO1,
     *  ROWBF(162),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(162),COLBF(194),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00187,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(87),ECHO1,
     *  ROWBF(163),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(163),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(163),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(163),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00808(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(104),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00809(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(163),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00188,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00811(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00812(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00813(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(190),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00814(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(190),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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(190),ECHO1,
     *  ROWBF(166),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00175,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(166),COLBF(196),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(190),ECHO1,
     *  ROWBF(167),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00175,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(167),COLBF(197),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00182,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(196),ECHO1,
     *  ROWBF(168),COLBF(196),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(168),COLBF(198),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00183,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(61),ECHO1,
     *  ROWBF(169),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(199),ECHO1,
     *  ROWBF(169),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(199),ECHO1,
     *  ROWBF(170),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(170),COLBF(200),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(199),ECHO1,
     *  ROWBF(171),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(171),COLBF(201),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(190),ECHO1,
     *  ROWBF(172),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(172),COLBF(202),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00187,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(87),ECHO1,
     *  ROWBF(173),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(173),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00832(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(104),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(173),COLBF(203),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00188,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QREGEX_ir_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00834(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(174),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00050,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00836(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(204),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00837(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00838(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(204),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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(204),ECHO1,
     *  ROWBF(176),COLBF(204),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00175,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(176),COLBF(205),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(204),ECHO1,
     *  ROWBF(177),COLBF(204),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00175,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(206),ECHO1,
     *  ROWBF(177),COLBF(206),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00182,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(57),ECHO1,
     *  ROWBF(178),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(178),COLBF(207),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(207),ECHO1,
     *  ROWBF(179),COLBF(207),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(208),ECHO1,
     *  ROWBF(179),COLBF(208),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00019')
      RETURN
      END
      SUBROUTINE S00851(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00186(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "QWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00186(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(182),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "QWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00851')
      RETURN
      END
      SUBROUTINE S00855(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      ENTRY=-C00051(SSMP(SSMPST(6)-1+I00001),I00005,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00855')
      RETURN
      END
      SUBROUTINE S00857(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwfob"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      176)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00175(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(176),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(184),COLBF(176),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00857')
      RETURN
      END
      SUBROUTINE S00858(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00177,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00177(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "viwcif"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'viwcif',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      177)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00177(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(177),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(184),COLBF(177),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "viwcif"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00858')
      RETURN
      END
      SUBROUTINE S00860(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00176(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      178)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00176(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(178),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(178),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00860')
      RETURN
      END
      SUBROUTINE S00861(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00178,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00178(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "viwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'viwreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      179)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00178(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(179),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(179),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "viwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00861')
      RETURN
      END
      SUBROUTINE S00865(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00059(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "DTBALR"',
     *  ' in equation "DTBALRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'DTBALR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      215)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100*C00059(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(215),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(215),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "DTBALR"',
     *  ' in equation "DTBALRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00865')
      RETURN
      END
      SUBROUTINE S00869(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00197,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00197(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDSEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0+C00197(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(188),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDSEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00869')
      RETURN
      END
      SUBROUTINE S00876(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00199(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ypev"',
     *  ' in equation "UTILELASPRIVEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ypev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      222)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00199(I00001,I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(222),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(190),COLBF(222),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ypev"',
     *  ' in equation "UTILELASPRIVEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00876')
      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 GTAPM_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QWLDIM_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(207),ECHO1,
     *  ROWBF(180),COLBF(207),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(180),COLBF(209),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(205),ECHO1,
     *  ROWBF(181),COLBF(205),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(210),ECHO1,
     *  ROWBF(181),COLBF(210),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00183,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00851(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(182),COLBF(211),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00187,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(183),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(183),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00855(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(183),COLBF(212),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00188,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00857(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(176),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00858(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(177),KZC,DOEQ,STRHS,STRHNZ,
     *  C00177,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(213),ECHO1,
     *  ROWBF(184),COLBF(213),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00860(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(178),KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(179),KZC,DOEQ,STRHS,STRHNZ,
     *  C00178,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(214),ECHO1,
     *  ROWBF(185),COLBF(214),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DTBALRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(186),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00189,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(214),ECHO1,
     *  ROWBF(186),COLBF(214),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00865(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(215),KZC,DOEQ,STRHS,STRHNZ,
     *  C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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''',
     *    '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(65),ECHO1,
     *  ROWBF(187),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(218),ECHO1,
     *  ROWBF(187),COLBF(218),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(223),ECHO1,
     *  ROWBF(187),COLBF(223),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00869(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00197,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(222),ECHO1,
     *  ROWBF(188),COLBF(222),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00197,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(224),ECHO1,
     *  ROWBF(188),COLBF(224),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(65),ECHO1,
     *  ROWBF(189),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(219),ECHO1,
     *  ROWBF(189),COLBF(219),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00198,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(222),ECHO1,
     *  ROWBF(189),COLBF(222),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(217),ECHO1,
     *  ROWBF(190),COLBF(217),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00876(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(222),KZC,DOEQ,STRHS,STRHNZ,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(224),ECHO1,
     *  ROWBF(190),COLBF(224),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(159),ECHO1,
     *  ROWBF(191),COLBF(159),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00203,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(191),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00204,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(191),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00205,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(226),ECHO1,
     *  ROWBF(191),COLBF(226),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(216),ECHO1,
     *  ROWBF(192),COLBF(216),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(217),ECHO1,
     *  ROWBF(192),COLBF(217),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00141,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(226),ECHO1,
     *  ROWBF(192),COLBF(226),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(159),ECHO1,
     *  ROWBF(193),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(216),ECHO1,
     *  ROWBF(193),COLBF(216),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(217),ECHO1,
     *  ROWBF(193),COLBF(217),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(221),ECHO1,
     *  ROWBF(193),COLBF(221),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(222),ECHO1,
     *  ROWBF(193),COLBF(222),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(160),ECHO1,
     *  ROWBF(194),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(216),ECHO1,
     *  ROWBF(194),COLBF(216),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(221),ECHO1,
     *  ROWBF(194),COLBF(221),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(223),ECHO1,
     *  ROWBF(194),COLBF(223),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(161),ECHO1,
     *  ROWBF(195),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(216),ECHO1,
     *  ROWBF(195),COLBF(216),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(221),ECHO1,
     *  ROWBF(195),COLBF(221),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(225),ECHO1,
     *  ROWBF(195),COLBF(225),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00020')
      RETURN
      END
      SUBROUTINE S00900(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=1.0
      RS2=C00206(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(197),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00900')
      RETURN
      END
      SUBROUTINE S00901(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00151(SSZ(1))
      REAL C00191(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      159)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00191(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00151(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(159),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(197),COLBF(159),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00901')
      RETURN
      END
      SUBROUTINE S00902(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00152(SSZ(1))
      REAL C00192(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      160)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00192(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00152(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(160),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(197),COLBF(160),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00902')
      RETURN
      END
      SUBROUTINE S00903(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00193,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00153(SSZ(1))
      REAL C00193(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      161)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00193(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00153(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(161),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(197),COLBF(161),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00903')
      RETURN
      END
      SUBROUTINE S00906(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yev"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      221)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-1.0
      RS2=C00206(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(221),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(197),COLBF(221),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yev"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00906')
      RETURN
      END
      SUBROUTINE S00907(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00190,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00190(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yev"',
     *  ' in equation "EVREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      221)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00190(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(221),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(198),COLBF(221),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yev"',
     *  ' in equation "EVREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00907')
      RETURN
      END
      SUBROUTINE S00911(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "psave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'psave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        1)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00207(I00002)*C00008(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(1),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(1),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "psave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00911')
      RETURN
      END
      SUBROUTINE S00912(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00060(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00912')
      RETURN
      END
      SUBROUTINE S00913(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00050(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00913')
      RETURN
      END
      SUBROUTINE S00914(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00061(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00914')
      RETURN
      END
      SUBROUTINE S00915(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00063(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00915')
      RETURN
      END
      SUBROUTINE S00916(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00064(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00916')
      RETURN
      END
      SUBROUTINE S00917(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00071,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(9)
      ENTRY=-0.01  *C00207(I00002)*C00071(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 4 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00207(I00002)*C00052(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(34),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00917')
      RETURN
      END
      SUBROUTINE S00918(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00207(I00002)*C00069(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00918')
      RETURN
      END
      SUBROUTINE S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00066(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00919')
      RETURN
      END
      SUBROUTINE S00920(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00067(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00920')
      RETURN
      END
      SUBROUTINE S00921(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00073(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00075(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(57),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00921')
      RETURN
      END
      SUBROUTINE S00922(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00207(I00002)*C00046(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00922')
      RETURN
      END
      SUBROUTINE S00923(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00079(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00079(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(59),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(59),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00923')
      RETURN
      END
      SUBROUTINE S00924(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00049(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(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=0.01  *C00207(I00002)*C00049(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(62),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00924')
      RETURN
      END
      SUBROUTINE S00925(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00052,C00060,C00061,C00063,C00064,C00066,C00067,
     *  C00069,C00071,C00073,C00075,C00190,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00052(SSZ(9),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 C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(9)
      RS1=RS1-C00071(I00001,I00002)
    2 CONTINUE
      RS2=0.0
      DO 4 I00005=1,SSZ(7)
      RS3=0.0
      DO 3 I00001=1,SSZ(6)
      RS3=RS3-C00069(I00001,I00005,I00002)
    3 CONTINUE
      RS2=RS2+RS3
    4 CONTINUE
      RS4=0.0
      DO 5 I00005=1,SSZ(7)
      RS5=0.0
      DO 6 I00001=1,SSZ(2)
      RS5=RS5-C00067(I00001,I00005,I00002)
    6 CONTINUE
      RS4=RS4+RS5
    5 CONTINUE
      RS6=0.0
      DO 7 I00005=1,SSZ(7)
      RS7=0.0
      DO 8 I00001=1,SSZ(2)
      RS7=RS7-C00066(I00001,I00005,I00002)
    8 CONTINUE
      RS6=RS6+RS7
    7 CONTINUE
      RS8=0.0
      DO 9 I00001=1,SSZ(2)
      RS8=RS8-C00064(I00001,I00002)
    9 CONTINUE
      RS9=0.0
      DO 10 I00001=1,SSZ(2)
      RS9=RS9-C00063(I00001,I00002)
   10 CONTINUE
      RS10=0.0
      DO 11 I00001=1,SSZ(2)
      RS10=RS10-C00061(I00001,I00002)
   11 CONTINUE
      RS11=0.0
      DO 12 I00001=1,SSZ(2)
      RS11=RS11-C00060(I00001,I00002)
   12 CONTINUE
      RS12=0.0
      DO 13 I00001=1,SSZ(2)
      RS13=0.0
      DO 14 I00003=1,SSZ(1)
      RS13=RS13-C00073(I00001,I00002,I00003)
   14 CONTINUE
      RS12=RS12+RS13
   13 CONTINUE
      RS14=0.0
      DO 15 I00001=1,SSZ(2)
      RS15=0.0
      DO 16 I00003=1,SSZ(1)
      RS15=RS15-C00075(I00001,I00003,I00002)
   16 CONTINUE
      RS14=RS14+RS15
   15 CONTINUE
      RS16=0.0
      DO 17 I00001=1,SSZ(6)
      RS16=RS16-C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00002)
   17 CONTINUE
      ENTRY=-(0.01  *C00207(I00002)*(RS1+RS2+RS4+RS6+RS8+RS9+RS10+RS11+
     *  RS12+RS14+RS16+C00046(I00002))+0.01  *C00190(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00925')
      RETURN
      END
      SUBROUTINE S00926(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00012,C00017,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00012(SSZ(4),SSZ(1))
      REAL C00017(SSZ(4),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "argd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'argd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00012(I00001,I00002)+
     *  C00017(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "argd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00926')
      RETURN
      END
      SUBROUTINE S00927(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00018,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(3),SSZ(1))
      REAL C00018(SSZ(4),SSZ(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "angd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'angd',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)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00013(I00001,I00004,I00002)+
     *  C00018(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "angd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00927')
      RETURN
      END
      SUBROUTINE S00928(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00022,C00027,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00022(SSZ(4),SSZ(1))
      REAL C00027(SSZ(4),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arpd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arpd',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)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00022(I00001,I00002)+
     *  C00027(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arpd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00928')
      RETURN
      END
      SUBROUTINE S00929(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00023,C00028,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00023(SSZ(4),SSZ(3),SSZ(1))
      REAL C00028(SSZ(4),SSZ(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anpd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00023(I00001,I00004,I00002)+
     *  C00028(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anpd"',
     *  ' in equation "EV_DECOMPOSITION"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ao"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ao',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00052(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(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ao"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00930')
      RETURN
      END
      SUBROUTINE S00931(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00112(SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ava"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ava',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)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00112(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(107),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ava"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00931')
      RETURN
      END
      SUBROUTINE S00932(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "af"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'af',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00051(SSMP(SSMPST(6)-1+
     *  I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "af"',
     *  ' in equation "EV_DECOMPOSITION"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afe"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00207(I00002)*C00051(SSMP(SSMPST(5)-1+
     *  I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(109),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(109),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afe"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00933')
      RETURN
      END
      SUBROUTINE S00934(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00047(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(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00934')
      RETURN
      END
      SUBROUTINE S00935(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00040,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(7),SSZ(1))
      REAL C00040(SSZ(4),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arfd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      122)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00034(I00001,I00005,I00002)+
     *  C00040(I00001,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(122),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(122),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arfd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00935')
      RETURN
      END
      SUBROUTINE S00936(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00041,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anfd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(7)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00035(I00001,I00004,I00005,I00002)+
     *  C00041(I00001,I00004,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00005-1+SSZ(7)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anfd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00936')
      RETURN
      END
      SUBROUTINE S00937(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(4),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anxd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      141)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00005=1,SSZ(4)
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00042(I00004,I00005,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00005-1+SSZ(4)*(I00002-1+SSZ(1)*(I00003-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(141),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(141),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anxd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00937')
      RETURN
      END
      SUBROUTINE S00938(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arxd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      142)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*C00043(I00005,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(4)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(142),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(142),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arxd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00938')
      RETURN
      END
      SUBROUTINE S00939(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atmfsd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atmfsd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      149)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00128(I00004,I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00001-1+SSZ(2)*(I00003-1+SSZ(1)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(149),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(149),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atmfsd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00939')
      RETURN
      END
      SUBROUTINE S00940(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(1))
      REAL C00208(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pt"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pt',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      157)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(3)
      ENTRY=0.01  *C00207(I00002)*C00208(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(157),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(157),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pt"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00940')
      RETURN
      END
      SUBROUTINE S00941(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00154,C00190,C00191,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00151(SSZ(1))
      REAL C00154(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00191(SSZ(1))
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      159)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00191(I00002)
      RS2=C00154(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00206(I00002)*C00190(I00002)*C00151(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(159),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(159),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00941')
      RETURN
      END
      SUBROUTINE S00942(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00155,C00190,C00192,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00152(SSZ(1))
      REAL C00155(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00192(SSZ(1))
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      160)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00192(I00002)
      RS2=C00155(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00206(I00002)*C00190(I00002)*C00152(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(160),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(160),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00942')
      RETURN
      END
      SUBROUTINE S00943(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00156,C00190,C00193,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00153(SSZ(1))
      REAL C00156(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00193(SSZ(1))
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      161)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00193(I00002)
      RS2=C00156(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00206(I00002)*C00190(I00002)*C00153(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(161),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),COLBF(161),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00943')
      RETURN
      END
      SUBROUTINE S00947(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00154,C00190,C00191,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00151(SSZ(1))
      REAL C00154(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00191(SSZ(1))
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      159)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00191(I00002)
      RS2=C00154(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00206(I00002)*C00190(I00002)*C00151(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(159),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(202),COLBF(159),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00947')
      RETURN
      END
      SUBROUTINE S00948(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00155,C00190,C00192,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00152(SSZ(1))
      REAL C00155(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00192(SSZ(1))
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      160)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00192(I00002)
      RS2=C00155(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00206(I00002)*C00190(I00002)*C00152(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(160),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(202),COLBF(160),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00948')
      RETURN
      END
      SUBROUTINE S00949(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00156,C00190,C00193,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00153(SSZ(1))
      REAL C00156(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00193(SSZ(1))
      REAL C00206(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      161)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00193(I00002)
      RS2=C00156(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00206(I00002)*C00190(I00002)*C00153(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(161),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(202),COLBF(161),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00949')
      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 GTAPM_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(220),ECHO1,
     *  ROWBF(196),COLBF(220),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(225),ECHO1,
     *  ROWBF(196),COLBF(225),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00900(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00901(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(159),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00902(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(160),KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00903(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(161),KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00193,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(197),COLBF(167),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(197),COLBF(168),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00906(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(221),KZC,DOEQ,STRHS,STRHNZ,
     *  C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S00907(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(221),KZC,DOEQ,STRHS,STRHNZ,
     *  C00190,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(227),ECHO1,
     *  ROWBF(198),COLBF(227),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(227),ECHO1,
     *  ROWBF(199),COLBF(227),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(228),ECHO1,
     *  ROWBF(199),COLBF(228),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00911(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(1),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00912(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00913(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00914(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00915(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00916(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00917(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00071,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00918(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00920(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00921(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00922(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00923(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(59),KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00924(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00925(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00052,C00060,C00061,C00063,C00064,C00066,C00067,
     *  C00069,C00071,C00073,C00075,C00190,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00926(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00012,C00017,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00927(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00018,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00928(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00022,C00027,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00929(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00023,C00028,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00931(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00932(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00934(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00935(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(122),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00040,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00936(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00041,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00937(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(141),KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00938(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(142),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00939(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(149),KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00940(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(157),KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(159),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00154,C00190,C00191,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(160),KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00155,C00190,C00192,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(161),KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00156,C00190,C00193,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(229),ECHO1,
     *  ROWBF(200),COLBF(229),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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(229),ECHO1,
     *  ROWBF(201),COLBF(229),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(230),ECHO1,
     *  ROWBF(201),COLBF(230),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S00947(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(159),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,C00154,C00190,C00191,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(160),KZC,DOEQ,STRHS,STRHNZ,
     *  C00152,C00155,C00190,C00192,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00949(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(161),KZC,DOEQ,STRHS,STRHNZ,
     *  C00153,C00156,C00190,C00193,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(231),ECHO1,
     *  ROWBF(202),COLBF(231),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00951(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00190,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00190(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_pop"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00190(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(203),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_pop"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00951')
      RETURN
      END
      SUBROUTINE S00953(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_qor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(9)
      ENTRY=-0.01  *C00207(I00002)*C00071(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(204),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_qor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00953')
      RETURN
      END
      SUBROUTINE S00954(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(9)
      RS1=RS1-0.01  *C00207(I00002)*C00071(I00001,I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(204),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00954')
      RETURN
      END
      SUBROUTINE S00956(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_qoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(9)
      RWN=RWN+1
      ENTRY=-C00071(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(205),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_qoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00956')
      RETURN
      END
      SUBROUTINE S00957(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(9)
      RWN=RWN+1
      ENTRY=C00071(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(205),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00957')
      RETURN
      END
      SUBROUTINE S00959(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_qfer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00069(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(206),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_qfer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00959')
      RETURN
      END
      SUBROUTINE S00960(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(6)
      RS2=RS2-C00069(I00001,I00005,I00002)*0.01  *C00207(I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(206),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00960')
      RETURN
      END
      SUBROUTINE S00962(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_qfeir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-C00069(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(207),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_qfeir"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfeir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1-C00069(I00001,I00005,I00002)*0.01  *C00207(I00002)
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(207),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfeir"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_qfeijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-C00069(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(208),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_qfeijr"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfeijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00069(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(208),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfeijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00966')
      RETURN
      END
      SUBROUTINE S00968(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_qfmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00067(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(209),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_qfmlr"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00005=1,SSZ(7)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2-C00067(I00001,I00005,I00002)*0.01  *C00207(I00002)
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(209),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00969')
      RETURN
      END
      SUBROUTINE S00971(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_qfmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-C00067(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(210),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_qfmlir"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1-C00067(I00001,I00005,I00002)*0.01  *C00207(I00002)
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(210),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00972')
      RETURN
      END
      SUBROUTINE S00974(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_qfmlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00067(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(211),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_qfmlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00974')
      RETURN
      END
      SUBROUTINE S00975(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfmlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00067(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(211),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfmlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00975')
      RETURN
      END
      SUBROUTINE S00977(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_qfdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00066(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(212),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_qfdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00977')
      RETURN
      END
      SUBROUTINE S00978(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00005=1,SSZ(7)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2-C00066(I00001,I00005,I00002)*0.01  *C00207(I00002)
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(212),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00978')
      RETURN
      END
      SUBROUTINE S00980(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_qfdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-C00066(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_qfdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00980')
      RETURN
      END
      SUBROUTINE S00981(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1-C00066(I00001,I00005,I00002)*0.01  *C00207(I00002)
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00981')
      RETURN
      END
      SUBROUTINE S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_qfdlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00066(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(214),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_qfdlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00983')
      RETURN
      END
      SUBROUTINE S00984(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfdlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00066(I00001,I00005,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(214),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qfdlijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00984')
      RETURN
      END
      SUBROUTINE S00986(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_qpmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00064(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(215),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_qpmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00986')
      RETURN
      END
      SUBROUTINE S00987(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00064(I00001,I00002)*0.01  *C00207(I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(215),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00987')
      RETURN
      END
      SUBROUTINE S00989(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_qpmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00064(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(216),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_qpmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00989')
      RETURN
      END
      SUBROUTINE S00990(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00064(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(216),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00990')
      RETURN
      END
      SUBROUTINE S00992(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_qpdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00063(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(217),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_qpdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00992')
      RETURN
      END
      SUBROUTINE S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00063(I00001,I00002)*0.01  *C00207(I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(217),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00993')
      RETURN
      END
      SUBROUTINE S00995(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_qpdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00063(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(218),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_qpdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00995')
      RETURN
      END
      SUBROUTINE S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00063(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(218),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qpdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00996')
      RETURN
      END
      SUBROUTINE S00998(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_qgmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00061(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(219),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_qgmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00998')
      RETURN
      END
      SUBROUTINE S00999(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00061(I00001,I00002)*0.01  *C00207(I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(219),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgmlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00999')
      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 GTAPM_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_pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00951(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00190,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(232),ECHO1,
     *  ROWBF(203),COLBF(232),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qor',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00953(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00954(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(233),ECHO1,
     *  ROWBF(204),COLBF(233),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qoir',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,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00957(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(234),ECHO1,
     *  ROWBF(205),COLBF(234),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfer',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00959(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00960(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(235),ECHO1,
     *  ROWBF(206),COLBF(235),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfeir',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,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(236),ECHO1,
     *  ROWBF(207),COLBF(236),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfeijr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00965(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(237),ECHO1,
     *  ROWBF(208),COLBF(237),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfmlr',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,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(238),ECHO1,
     *  ROWBF(209),COLBF(238),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfmlir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00971(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(239),ECHO1,
     *  ROWBF(210),COLBF(239),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfmlijr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00974(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00975(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(211),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfdlr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00977(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00978(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(212),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfdlir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00980(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00981(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(213),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qfdlijr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00984(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(214),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qpmlr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00986(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00987(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(244),ECHO1,
     *  ROWBF(215),COLBF(244),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qpmlir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00989(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00990(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(216),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qpdlr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00992(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(246),ECHO1,
     *  ROWBF(217),COLBF(246),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qpdlir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00995(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(247),ECHO1,
     *  ROWBF(218),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qgmlr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00998(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00999(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(248),ECHO1,
     *  ROWBF(219),COLBF(248),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01001(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_qgmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00061(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(220),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_qgmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01001')
      RETURN
      END
      SUBROUTINE S01002(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00061(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(220),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgmlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01002')
      RETURN
      END
      SUBROUTINE S01004(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_qgdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00060(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(221),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_qgdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01004')
      RETURN
      END
      SUBROUTINE S01005(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00060(I00001,I00002)*0.01  *C00207(I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(221),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgdlr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01005')
      RETURN
      END
      SUBROUTINE S01007(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_qgdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00060(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(222),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_qgdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01007')
      RETURN
      END
      SUBROUTINE S01008(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00060(I00001,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(222),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qgdlir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01008')
      RETURN
      END
      SUBROUTINE S01010(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qxlsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00073(I00001,I00002,I00003)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(223),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qxlsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01010')
      RETURN
      END
      SUBROUTINE S01011(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qxlsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00073(I00001,I00002,I00003)*0.01  *C00207(I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(223),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qxlsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01011')
      RETURN
      END
      SUBROUTINE S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qxsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00073(I00001,I00002,I00003)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(224),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qxsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01013')
      RETURN
      END
      SUBROUTINE S01014(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qxsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00073(I00001,I00002,I00003)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(224),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qxsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01014')
      RETURN
      END
      SUBROUTINE S01016(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qimr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00075(I00001,I00003,I00002)*0.01  *C00207(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(225),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qimr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01016')
      RETURN
      END
      SUBROUTINE S01017(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qimr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00075(I00001,I00003,I00002)*0.01  *C00207(I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(225),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qimr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01017')
      RETURN
      END
      SUBROUTINE S01019(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qimisr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00075(I00001,I00003,I00002)*0.01  *C00207(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(226),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_qimisr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01019')
      RETURN
      END
      SUBROUTINE S01020(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qimisr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00075(I00001,I00003,I00002)*0.01  *C00207(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(226),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_qimisr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01020')
      RETURN
      END
      SUBROUTINE S01022(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00060(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01022')
      RETURN
      END
      SUBROUTINE S01023(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00061(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_alleffr"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00063(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_alleffr"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00064(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_alleffr"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(9)
      ENTRY=-0.01  *C00207(I00002)*C00071(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01026')
      RETURN
      END
      SUBROUTINE S01027(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00207(I00002)*C00069(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01027')
      RETURN
      END
      SUBROUTINE S01028(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00066(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01028')
      RETURN
      END
      SUBROUTINE S01029(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00067(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01029')
      RETURN
      END
      SUBROUTINE S01030(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00073(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00075(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(57),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01030')
      RETURN
      END
      SUBROUTINE S01031(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00063,C00064,C00066,C00067,C00069,C00071,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(9)
      RS1=RS1-C00071(I00001,I00002)
    2 CONTINUE
      RS2=0.0
      DO 4 I00005=1,SSZ(7)
      RS3=0.0
      DO 3 I00001=1,SSZ(6)
      RS3=RS3-C00069(I00001,I00005,I00002)
    3 CONTINUE
      RS2=RS2+RS3
    4 CONTINUE
      RS4=0.0
      DO 5 I00005=1,SSZ(7)
      RS5=0.0
      DO 6 I00001=1,SSZ(2)
      RS5=RS5-C00067(I00001,I00005,I00002)
    6 CONTINUE
      RS4=RS4+RS5
    5 CONTINUE
      RS6=0.0
      DO 7 I00005=1,SSZ(7)
      RS7=0.0
      DO 8 I00001=1,SSZ(2)
      RS7=RS7-C00066(I00001,I00005,I00002)
    8 CONTINUE
      RS6=RS6+RS7
    7 CONTINUE
      RS8=0.0
      DO 9 I00001=1,SSZ(2)
      RS8=RS8-C00064(I00001,I00002)
    9 CONTINUE
      RS9=0.0
      DO 10 I00001=1,SSZ(2)
      RS9=RS9-C00063(I00001,I00002)
   10 CONTINUE
      RS10=0.0
      DO 11 I00001=1,SSZ(2)
      RS10=RS10-C00061(I00001,I00002)
   11 CONTINUE
      RS11=0.0
      DO 12 I00001=1,SSZ(2)
      RS11=RS11-C00060(I00001,I00002)
   12 CONTINUE
      RS12=0.0
      DO 13 I00001=1,SSZ(2)
      RS13=0.0
      DO 14 I00003=1,SSZ(1)
      RS13=RS13-C00073(I00001,I00002,I00003)
   14 CONTINUE
      RS12=RS12+RS13
   13 CONTINUE
      RS14=0.0
      DO 15 I00001=1,SSZ(2)
      RS15=0.0
      DO 16 I00003=1,SSZ(1)
      RS15=RS15-C00075(I00001,I00003,I00002)
   16 CONTINUE
      RS14=RS14+RS15
   15 CONTINUE
      ENTRY=-0.01  *C00207(I00002)*(RS1+RS2+RS4+RS6+RS8+RS9+RS10+RS11+
     *  RS12+RS14)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01031')
      RETURN
      END
      SUBROUTINE S01033(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00071(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01033')
      RETURN
      END
      SUBROUTINE S01034(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00069(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfe"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01034')
      RETURN
      END
      SUBROUTINE S01035(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00069(SSZ(6),SSZ(7),SSZ(1))
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',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)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1-C00069(I00001,I00005,I00002)
    3 CONTINUE
      ENTRY=-0.01  *C00207(I00002)*(-C00071(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)+RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01035')
      RETURN
      END
      SUBROUTINE S01036(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'CNTalleffir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      257)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(5)-1+I00001)+SSZ(8)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(257),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(257),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01036')
      RETURN
      END
      SUBROUTINE S01037(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00060(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgdl"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01037')
      RETURN
      END
      SUBROUTINE S01038(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00061(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgml"',
     *  ' in equation "CONT_EV_alleffir_T"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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 C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       20)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00063(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(20),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(20),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpdl"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01039')
      RETURN
      END
      SUBROUTINE S01040(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00064(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpml"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01040')
      RETURN
      END
      SUBROUTINE S01041(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00071(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01041')
      RETURN
      END
      SUBROUTINE S01042(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfdl',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00066(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfdl"',
     *  ' in equation "CONT_EV_alleffir_T"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfml',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       45)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00067(I00001,I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfml"',
     *  ' in equation "CONT_EV_alleffir_T"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxls',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      ENTRY=-0.01  *C00207(I00002)*C00073(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(57),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      DO 5 I00003=1,SSZ(1)
      ENTRY=-0.01  *C00207(I00002)*C00075(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(57),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxls"',
     *  ' in equation "CONT_EV_alleffir_T"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00063,C00064,C00066,C00067,C00071,C00073,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(7),SSZ(1))
      REAL C00067(SSZ(2),SSZ(7),SSZ(1))
      REAL C00071(SSZ(9),SSZ(1))
      REAL C00073(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00005=1,SSZ(7)
      RS1=RS1-C00067(I00001,I00005,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00005=1,SSZ(7)
      RS2=RS2-C00066(I00001,I00005,I00002)
    4 CONTINUE
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=RS3-C00073(I00001,I00002,I00003)
    5 CONTINUE
      RS4=0.0
      DO 6 I00003=1,SSZ(1)
      RS4=RS4-C00075(I00001,I00003,I00002)
    6 CONTINUE
      ENTRY=-0.01  *C00207(I00002)*(-C00071(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)+RS1+RS2-C00064(I00001,I00002)-
     *  C00063(I00001,I00002)-C00061(I00001,I00002)-
     *  C00060(I00001,I00002)+RS3+RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01045')
      RETURN
      END
      SUBROUTINE S01046(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'CNTalleffir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      257)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(6)-1+I00001)+SSZ(8)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(257),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(257),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01046')
      RETURN
      END
      SUBROUTINE S01047(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00050(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01047')
      RETURN
      END
      SUBROUTINE S01048(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00049(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(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=0.01  *C00207(I00002)*C00049(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(62),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01048')
      RETURN
      END
      SUBROUTINE S01049(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(1))
      REAL C00208(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pt"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pt',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      157)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(3)
      ENTRY=0.01  *C00207(I00002)*C00208(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(157),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(157),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pt"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01049')
      RETURN
      END
      SUBROUTINE S01050(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00050,C00207,C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL C00050(SSZ(3),SSZ(1))
      REAL C00207(SSZ(1))
      REAL C00208(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxwwld"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxwwld',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      198)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00049(I00001,I00002,I00003)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      RS3=0.0
      DO 4 I00004=1,SSZ(3)
      RS3=RS3-C00050(I00004,I00002)
    4 CONTINUE
      RS4=0.0
      DO 6 I00003=1,SSZ(1)
      RS5=0.0
      DO 5 I00001=1,SSZ(2)
      RS5=RS5-C00049(I00001,I00003,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    6 CONTINUE
      RS6=0.0
      DO 7 I00004=1,SSZ(3)
      RS6=RS6-C00208(I00004,I00002)
    7 CONTINUE
      ENTRY=-0.01  *C00207(I00002)*(RS1+RS3-RS4-RS6)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(198),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(198),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxwwld"',
     *  ' in equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01050')
      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 GTAPM_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_qgmlir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01001(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01002(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(220),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qgdlr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01004(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01005(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(250),ECHO1,
     *  ROWBF(221),COLBF(250),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qgdlir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01007(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01008(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(222),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qxlsr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01010(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01011(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(252),ECHO1,
     *  ROWBF(223),COLBF(252),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qxsirs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01014(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(253),ECHO1,
     *  ROWBF(224),COLBF(253),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qimr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01016(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01017(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(225),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_qimisr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01019(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01020(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(226),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_alleffr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01022(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01023(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01027(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01028(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01029(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01030(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01031(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00063,C00064,C00066,C00067,C00069,C00071,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(227),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01033(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01034(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01035(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01036(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(257),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S01037(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01038(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(20),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01040(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00064,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01041(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00071,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(45),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00073,C00075,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00063,C00064,C00066,C00067,C00071,C00073,
     *  C00075,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01046(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(257),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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_totr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01047(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01048(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00207,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01049(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(157),KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01050(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(198),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00050,C00207,C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(230),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01052(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "psave"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'psave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        1)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00207(I00002)*C00008(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(1),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(1),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "psave"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01052')
      RETURN
      END
      SUBROUTINE S01053(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00079(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00079(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(59),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(59),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01053')
      RETURN
      END
      SUBROUTINE S01054(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00079,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL C00079(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxwwld"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxwwld',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      198)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*(-C00079(I00002)+C00008(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(198),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(198),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxwwld"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01054')
      RETURN
      END
      SUBROUTINE S01056(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00207(I00002)*C00052(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(232),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01056')
      RETURN
      END
      SUBROUTINE S01057(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00207(I00002)*C00046(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(232),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01057')
      RETURN
      END
      SUBROUTINE S01058(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00052(SSZ(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1-C00052(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      ENTRY=-0.01  *C00207(I00002)*(RS1+C00046(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(232),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01058')
      RETURN
      END
      SUBROUTINE S01060(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00052(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(34),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(233),COLBF(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01060')
      RETURN
      END
      SUBROUTINE S01061(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=0.01  *C00207(I00002)*C00052(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(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(233),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01061')
      RETURN
      END
      SUBROUTINE S01063(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00012,C00017,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00012(SSZ(4),SSZ(1))
      REAL C00017(SSZ(4),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "argd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'argd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00012(I00001,I00002)+
     *  C00017(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "argd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01063')
      RETURN
      END
      SUBROUTINE S01064(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00018,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(3),SSZ(1))
      REAL C00018(SSZ(4),SSZ(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "angd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'angd',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)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00013(I00001,I00004,I00002)+
     *  C00018(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "angd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01064')
      RETURN
      END
      SUBROUTINE S01065(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00022,C00027,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00022(SSZ(4),SSZ(1))
      REAL C00027(SSZ(4),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arpd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arpd',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)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00022(I00001,I00002)+
     *  C00027(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arpd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01065')
      RETURN
      END
      SUBROUTINE S01066(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00023,C00028,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00023(SSZ(4),SSZ(3),SSZ(1))
      REAL C00028(SSZ(4),SSZ(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anpd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00023(I00001,I00004,I00002)+
     *  C00028(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anpd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01066')
      RETURN
      END
      SUBROUTINE S01067(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ao"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ao',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00052(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(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ao"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01067')
      RETURN
      END
      SUBROUTINE S01068(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00112(SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ava"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ava',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)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00112(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(107),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ava"',
     *  ' in equation "CONT_EV_techr"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00036,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(7),SSZ(1))
      REAL C00036(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "af"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'af',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*(C00036(I00001,I00005,I00002)+
     *  C00031(I00001,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "af"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01069')
      RETURN
      END
      SUBROUTINE S01070(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afe"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00207(I00002)*C00051(SSMP(SSMPST(5)-1+
     *  I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(109),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(109),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afe"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01070')
      RETURN
      END
      SUBROUTINE S01071(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00047(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(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01071')
      RETURN
      END
      SUBROUTINE S01072(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00040,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(7),SSZ(1))
      REAL C00040(SSZ(4),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arfd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      122)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00034(I00001,I00005,I00002)+
     *  C00040(I00001,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(122),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(122),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arfd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01072')
      RETURN
      END
      SUBROUTINE S01073(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00041,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anfd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(7)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00035(I00001,I00004,I00005,I00002)+
     *  C00041(I00001,I00004,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00005-1+SSZ(7)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anfd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01073')
      RETURN
      END
      SUBROUTINE S01074(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(4),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anxd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      141)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00005=1,SSZ(4)
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00042(I00004,I00005,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00005-1+SSZ(4)*(I00002-1+SSZ(1)*(I00003-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(141),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(141),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anxd"',
     *  ' in equation "CONT_EV_techr"',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,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arxd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      142)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*C00043(I00005,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(4)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(142),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(142),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arxd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01075')
      RETURN
      END
      SUBROUTINE S01076(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atmfsd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atmfsd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      149)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00128(I00004,I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00001-1+SSZ(2)*(I00003-1+SSZ(1)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(149),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(149),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atmfsd"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01076')
      RETURN
      END
      SUBROUTINE S01078(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00023,C00028,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00023(SSZ(4),SSZ(3),SSZ(1))
      REAL C00028(SSZ(4),SSZ(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anpd"',
     *  ' in equation "CONT_EV_tech_anpd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00023(I00001,I00004,I00002)+
     *  C00028(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(235),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anpd"',
     *  ' in equation "CONT_EV_tech_anpd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01078')
      RETURN
      END
      SUBROUTINE S01080(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00022,C00027,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00022(SSZ(4),SSZ(1))
      REAL C00027(SSZ(4),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arpd"',
     *  ' in equation "CONT_EV_tech_arpd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arpd',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)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00022(I00001,I00002)+
     *  C00027(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(236),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arpd"',
     *  ' in equation "CONT_EV_tech_arpd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01080')
      RETURN
      END
      SUBROUTINE S01082(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00018,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(3),SSZ(1))
      REAL C00018(SSZ(4),SSZ(3),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "angd"',
     *  ' in equation "CONT_EV_tech_abmg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'angd',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)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00013(I00001,I00004,I00002)+
     *  C00018(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(237),COLBF(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "angd"',
     *  ' in equation "CONT_EV_tech_abmg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01082')
      RETURN
      END
      SUBROUTINE S01084(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00012,C00017,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00012(SSZ(4),SSZ(1))
      REAL C00017(SSZ(4),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "argd"',
     *  ' in equation "CONT_EV_tech_anmg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'argd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00012(I00001,I00002)+
     *  C00017(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(238),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "argd"',
     *  ' in equation "CONT_EV_tech_anmg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01084')
      RETURN
      END
      SUBROUTINE S01086(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00041,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER 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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anfd"',
     *  ' in equation "CONT_EV_tech_anfd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(7)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00035(I00001,I00004,I00005,I00002)+
     *  C00041(I00001,I00004,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00005-1+SSZ(7)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(239),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anfd"',
     *  ' in equation "CONT_EV_tech_anfd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01086')
      RETURN
      END
      SUBROUTINE S01088(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00040,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(7),SSZ(1))
      REAL C00040(SSZ(4),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arfd"',
     *  ' in equation "CONT_EV_tech_arfd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      122)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*(C00034(I00001,I00005,I00002)+
     *  C00040(I00001,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(122),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(240),COLBF(122),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arfd"',
     *  ' in equation "CONT_EV_tech_arfd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01088')
      RETURN
      END
      SUBROUTINE S01090(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      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,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(4),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "anxd"',
     *  ' in equation "CONT_EV_tech_anxd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'anxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      141)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00005=1,SSZ(4)
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00042(I00004,I00005,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00005-1+SSZ(4)*(I00002-1+SSZ(1)*(I00003-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(141),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(241),COLBF(141),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "anxd"',
     *  ' in equation "CONT_EV_tech_anxd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01090')
      RETURN
      END
      SUBROUTINE S01092(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "arxd"',
     *  ' in equation "CONT_EV_tech_arxd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'arxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      142)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00005=1,SSZ(4)
      ENTRY=-0.01  *C00207(I00002)*C00043(I00005,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(4)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(142),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(242),COLBF(142),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "arxd"',
     *  ' in equation "CONT_EV_tech_arxd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01092')
      RETURN
      END
      SUBROUTINE S01094(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ao"',
     *  ' in equation "CONT_EV_tech_aor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ao',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00052(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(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(243),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ao"',
     *  ' in equation "CONT_EV_tech_aor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01094')
      RETURN
      END
      SUBROUTINE S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ao"',
     *  ' in equation "CONT_EV_tech_aoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ao',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00052(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(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(244),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ao"',
     *  ' in equation "CONT_EV_tech_aoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01096')
      RETURN
      END
      SUBROUTINE S01098(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afe"',
     *  ' in equation "CONT_EV_tech_afer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00207(I00002)*C00051(SSMP(SSMPST(5)-1+
     *  I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(109),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(245),COLBF(109),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afe"',
     *  ' in equation "CONT_EV_tech_afer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01098')
      RETURN
      END
      SUBROUTINE S01100(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00051(SSZ(8),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afe"',
     *  ' in equation "CONT_EV_tech_afeijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00051(SSMP(SSMPST(5)-1+
     *  I00001),I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(6)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(109),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(246),COLBF(109),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afe"',
     *  ' in equation "CONT_EV_tech_afeijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01100')
      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 GTAPM_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''',
     *    'CNT_EV_cgdsr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01052(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(1),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01053(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(59),KZC,DOEQ,STRHS,STRHNZ,
     *  C00079,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01054(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(198),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00079,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(231),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01056(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01057(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01058(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(232),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01060(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01061(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(233),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01063(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00012,C00017,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01064(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00018,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01065(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00022,C00027,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01066(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00023,C00028,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01067(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00036,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01070(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01071(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(122),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00040,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01073(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00041,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01074(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(141),KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,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,
     *  KSTEP,SMND(142),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01076(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(149),KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(234),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,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_anpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01078(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00023,C00028,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(263),ECHO1,
     *  ROWBF(235),COLBF(263),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_arpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01080(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00022,C00027,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(264),ECHO1,
     *  ROWBF(236),COLBF(264),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_abmg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01082(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00018,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(265),ECHO1,
     *  ROWBF(237),COLBF(265),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_anmg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01084(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00012,C00017,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(266),ECHO1,
     *  ROWBF(238),COLBF(266),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_anfd',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,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00041,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(267),ECHO1,
     *  ROWBF(239),COLBF(267),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_arfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01088(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(122),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00040,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(268),ECHO1,
     *  ROWBF(240),COLBF(268),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_anxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01090(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(141),KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(269),ECHO1,
     *  ROWBF(241),COLBF(269),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_arxd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01092(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(142),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(270),ECHO1,
     *  ROWBF(242),COLBF(270),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_aor',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01094(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(271),ECHO1,
     *  ROWBF(243),COLBF(271),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_aoir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(272),ECHO1,
     *  ROWBF(244),COLBF(272),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_afer',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01098(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(273),ECHO1,
     *  ROWBF(245),COLBF(273),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_afeijr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01100(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00051,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(274),ECHO1,
     *  ROWBF(246),COLBF(274),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01102(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00112(SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ava"',
     *  ' in equation "CONT_EV_tech_avar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ava',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)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(7)
      ENTRY=-0.01  *C00207(I00002)*C00112(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
    2 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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ava"',
     *  ' in equation "CONT_EV_tech_avar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01102')
      RETURN
      END
      SUBROUTINE S01104(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00112(SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ava"',
     *  ' in equation "CONT_EV_tech_avajr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ava',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      107)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00112(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(7)*(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
      END IF
      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,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ava"',
     *  ' in equation "CONT_EV_tech_avajr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01104')
      RETURN
      END
      SUBROUTINE S01106(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00036,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(7),SSZ(1))
      REAL C00036(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "af"',
     *  ' in equation "CONT_EV_tech_afr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'af',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*(C00036(I00001,I00005,I00002)+
     *  C00031(I00001,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(249),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "af"',
     *  ' in equation "CONT_EV_tech_afr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01106')
      RETURN
      END
      SUBROUTINE S01108(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00036,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(7),SSZ(1))
      REAL C00036(SSZ(2),SSZ(7),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "af"',
     *  ' in equation "CONT_EV_tech_afijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'af',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*(C00036(I00001,I00005,I00002)+
     *  C00031(I00001,I00005,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00005-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(250),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "af"',
     *  ' in equation "CONT_EV_tech_afijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01108')
      RETURN
      END
      SUBROUTINE S01110(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atmfsd"',
     *  ' in equation "CONT_EV_tech_atrr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atmfsd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      149)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      ENTRY=-0.01  *C00207(I00002)*C00128(I00004,I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00001-1+SSZ(2)*(I00003-1+SSZ(1)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(149),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(251),COLBF(149),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atmfsd"',
     *  ' in equation "CONT_EV_tech_atrr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01110')
      RETURN
      END
      SUBROUTINE S01112(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atmfsd"',
     *  ' in equation "CONT_EV_tech_afmfdsd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atmfsd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      149)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      DO     4 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00003)*C00128(I00004,I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(3)*(I00001-1+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(149),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(252),COLBF(149),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atmfsd"',
     *  ' in equation "CONT_EV_tech_afmfdsd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01112')
      RETURN
      END
      SUBROUTINE S01114(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00207(I00002)*C00047(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(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(253),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01114')
      RETURN
      END
      SUBROUTINE S01116(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00047(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(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(254),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01116')
      RETURN
      END
      SUBROUTINE S01118(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00207(I00002)*C00046(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(255),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01118')
      RETURN
      END
      SUBROUTINE S01119(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL C00207(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00207(I00002)*C00046(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(255),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01119')
      RETURN
      END
      SUBROUTINE S01121(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  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,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00210(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004)))+SSZ(9)*(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
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(256),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01121')
      RETURN
      END
      SUBROUTINE S01122(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00209,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00209(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(256),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01122')
      RETURN
      END
      SUBROUTINE S01123(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      284)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(284),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(256),COLBF(284),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01123')
      RETURN
      END
      SUBROUTINE S01124(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00209,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00209(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(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(257),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01124')
      RETURN
      END
      SUBROUTINE S01125(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      284)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(284),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(257),COLBF(284),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01125')
      RETURN
      END
      SUBROUTINE S01126(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00214,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00214(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00214(SSMP(SSMPST(1)-1+I00004),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(258),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01126')
      RETURN
      END
      SUBROUTINE S01128(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      287)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00004)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(287),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(258),COLBF(287),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01128')
      RETURN
      END
      SUBROUTINE S01129(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00214,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00214(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfob"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00214(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(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(259),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfob"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01129')
      RETURN
      END
      SUBROUTINE S01130(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      287)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(287),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(259),COLBF(287),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01130')
      RETURN
      END
      SUBROUTINE S01135(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00216(SSZ(2),SSZ(1))
      REAL C00217(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_i"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      285)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(C00216(I00001,I00002)-C00217(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(285),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(262),COLBF(285),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_i"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01135')
      RETURN
      END
      SUBROUTINE S01136(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,MBNCOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(MBNCOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00216(SSZ(2),SSZ(1))
      REAL C00217(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      286)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00216(I00001,I00002)-C00217(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(286),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(262),COLBF(286),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01136')
      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 GTAPM_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_avar',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,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(275),ECHO1,
     *  ROWBF(247),COLBF(275),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_avajr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01104(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(276),ECHO1,
     *  ROWBF(248),COLBF(276),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01106(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00036,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(277),ECHO1,
     *  ROWBF(249),COLBF(277),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_afijr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01108(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00036,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(278),ECHO1,
     *  ROWBF(250),COLBF(278),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01110(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(149),KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(279),ECHO1,
     *  ROWBF(251),COLBF(279),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_afmfdsd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01112(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(149),KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(280),ECHO1,
     *  ROWBF(252),COLBF(280),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01114(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(281),ECHO1,
     *  ROWBF(253),COLBF(281),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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_amsirs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01116(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(282),ECHO1,
     *  ROWBF(254),COLBF(282),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01118(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01119(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00046,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(283),ECHO1,
     *  ROWBF(255),COLBF(283),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01121(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00210,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01122(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00209,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01123(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(284),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S01124(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00209,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01125(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(284),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S01126(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00214,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(258),COLBF(157),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00215,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01128(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(287),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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 S01129(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00214,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01130(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(287),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,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(284),ECHO1,
     *  ROWBF(260),COLBF(284),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00218,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(285),ECHO1,
     *  ROWBF(260),COLBF(285),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(285),ECHO1,
     *  ROWBF(261),COLBF(285),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00219,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(286),ECHO1,
     *  ROWBF(261),COLBF(286),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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 S01135(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(285),KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01136(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(286),KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,MBNCOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(288),ECHO1,
     *  ROWBF(262),COLBF(288),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(284),ECHO1,
     *  ROWBF(263),COLBF(284),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00216,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(285),ECHO1,
     *  ROWBF(263),COLBF(285),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00216,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(289),ECHO1,
     *  ROWBF(263),COLBF(289),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(285),ECHO1,
     *  ROWBF(264),COLBF(285),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00217,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(287),ECHO1,
     *  ROWBF(264),COLBF(287),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00217,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(290),ECHO1,
     *  ROWBF(264),COLBF(290),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(288),ECHO1,
     *  ROWBF(265),COLBF(288),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(291),ECHO1,
     *  ROWBF(265),COLBF(291),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c2_rEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(289),ECHO1,
     *  ROWBF(266),COLBF(289),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(292),ECHO1,
     *  ROWBF(266),COLBF(292),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(290),ECHO1,
     *  ROWBF(267),COLBF(290),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(293),ECHO1,
     *  ROWBF(267),COLBF(293),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .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(291),ECHO1,
     *  ROWBF(268),COLBF(291),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(292),ECHO1,
     *  ROWBF(268),COLBF(292),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(293),ECHO1,
     *  ROWBF(268),COLBF(293),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(294),ECHO1,
     *  ROWBF(268),COLBF(294),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,MBNCOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00001,
     *  U00001,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00001(1)
      REAL U00001(1)
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VERNUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      U00001(1)=C00001(1)*0.0
      CALL GPARW(SIZE(C00001),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(1),KSTEP,NSTEP,METHOD,
     *    1,1,1,1,
     *    1,1,1,
     *    1,1,1,1,
     *    1,1,1,
     *    C00001,U00001,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VERNUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01154')
      RETURN
      END
      SUBROUTINE S01156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,
     *  V00001,V00002,
     *  U00008,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00008(SSZ(1))
      REAL V00001(SSZ(1))
      REAL V00002(SSZ(1))
      REAL U00008(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00008(I00002)=C00008(I00002)*(V00001(I00002)/100.0 +
     *  V00002(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00008),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(8),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00008,U00008,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "SAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01156')
      RETURN
      END
      SUBROUTINE S01157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00009,
     *  V00003,V00004,
     *  U00009,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00009(SSZ(2),SSZ(1))
      REAL V00003(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL U00009(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00009(I00001,I00002)=C00009(I00001,I00002)*
     *  (V00003(I00001,I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00009),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(9),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00009,U00009,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01157')
      RETURN
      END
      SUBROUTINE S01158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00010,
     *  V00004,V00005,
     *  U00010,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00005(SSZ(2),SSZ(1))
      REAL U00010(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00010(I00001,I00002)=C00010(I00001,I00002)*
     *  (V00005(I00001,I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00010),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(10),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00010,U00010,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDGF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01158')
      RETURN
      END
      SUBROUTINE S01159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00011,
     *  V00006,V00007,
     *  U00011,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00007(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
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00011(I00001,I00002)=C00011(I00001,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00007(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00011),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(11),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00011,U00011,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01159')
      RETURN
      END
      SUBROUTINE S01160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00012,
     *  V00008,V00009,
     *  U00012,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00012(SSZ(4),SSZ(1))
      REAL V00008(SSZ(4),SSZ(1))
      REAL V00009(SSZ(4),SSZ(1))
      REAL U00012(SSZ(4),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "DGMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      U00012(I00001,I00002)=C00012(I00001,I00002)*
     *  (V00008(I00001,I00002)/100.0 +V00009(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00012),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(12),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    C00012,U00012,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "DGMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01160')
      RETURN
      END
      SUBROUTINE S01161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00013,
     *  V00006,V00010,
     *  U00013,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00013(SSZ(4),SSZ(3),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00010(SSZ(4),SSZ(3),SSZ(1))
      REAL U00013(SSZ(4),SSZ(3),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VNDG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00013(I00001,I00004,I00002)=C00013(I00001,I00004,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004))),I00002)/100.0 +V00010(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00013),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(13),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    C00013,U00013,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VNDG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01161')
      RETURN
      END
      SUBROUTINE S01162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00014,
     *  V00011,V00012,
     *  U00014,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL V00011(SSZ(2),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL U00014(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00014(I00001,I00002)=C00014(I00001,I00002)*
     *  (V00011(I00001,I00002)/100.0 +V00012(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00014),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(14),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00014,U00014,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01162')
      RETURN
      END
      SUBROUTINE S01163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00015,
     *  V00012,V00013,
     *  U00015,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL U00015(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00015(I00001,I00002)=C00015(I00001,I00002)*
     *  (V00013(I00001,I00002)/100.0 +V00012(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00015),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(15),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00015,U00015,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIGF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01163')
      RETURN
      END
      SUBROUTINE S01164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00016,
     *  V00014,V00015,
     *  U00016,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL V00014(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL U00016(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00016(I00001,I00002)=C00016(I00001,I00002)*
     *  (V00014(I00001,I00002)/100.0 +V00015(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00016),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(16),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00016,U00016,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01164')
      RETURN
      END
      SUBROUTINE S01165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00017,
     *  V00016,V00017,
     *  U00017,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00017(SSZ(4),SSZ(1))
      REAL V00016(SSZ(4),SSZ(1))
      REAL V00017(SSZ(4),SSZ(1))
      REAL U00017(SSZ(4),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "IGMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      U00017(I00001,I00002)=C00017(I00001,I00002)*
     *  (V00016(I00001,I00002)/100.0 +V00017(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00017),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(17),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    C00017,U00017,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "IGMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01165')
      RETURN
      END
      SUBROUTINE S01166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00018,
     *  V00006,V00018,
     *  U00018,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00018(SSZ(4),SSZ(3),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00018(SSZ(4),SSZ(3),SSZ(1))
      REAL U00018(SSZ(4),SSZ(3),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VNIG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00018(I00001,I00004,I00002)=C00018(I00001,I00004,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004))),I00002)/100.0 +V00018(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00018),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(18),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    C00018,U00018,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VNIG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01166')
      RETURN
      END
      SUBROUTINE S01167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00019,
     *  V00019,V00020,
     *  U00019,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL V00019(SSZ(2),SSZ(1))
      REAL V00020(SSZ(2),SSZ(1))
      REAL U00019(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00019(I00001,I00002)=C00019(I00001,I00002)*
     *  (V00019(I00001,I00002)/100.0 +V00020(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00019),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(19),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00019,U00019,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01167')
      RETURN
      END
      SUBROUTINE S01168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00020,
     *  V00020,V00021,
     *  U00020,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00020(SSZ(2),SSZ(1))
      REAL V00020(SSZ(2),SSZ(1))
      REAL V00021(SSZ(2),SSZ(1))
      REAL U00020(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00020(I00001,I00002)=C00020(I00001,I00002)*
     *  (V00021(I00001,I00002)/100.0 +V00020(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00020),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(20),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00020,U00020,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDPF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01168')
      RETURN
      END
      SUBROUTINE S01169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00021,
     *  V00006,V00022,
     *  U00021,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00021(SSZ(2),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00022(SSZ(2),SSZ(1))
      REAL U00021(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00021(I00001,I00002)=C00021(I00001,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00022(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00021),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(21),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00021,U00021,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01169')
      RETURN
      END
      SUBROUTINE S01170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00022,
     *  V00023,V00024,
     *  U00022,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00022(SSZ(4),SSZ(1))
      REAL V00023(SSZ(4),SSZ(1))
      REAL V00024(SSZ(4),SSZ(1))
      REAL U00022(SSZ(4),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "DPMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      U00022(I00001,I00002)=C00022(I00001,I00002)*
     *  (V00023(I00001,I00002)/100.0 +V00024(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00022),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(22),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    C00022,U00022,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "DPMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01170')
      RETURN
      END
      SUBROUTINE S01171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00023,
     *  V00006,V00025,
     *  U00023,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00023(SSZ(4),SSZ(3),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00025(SSZ(4),SSZ(3),SSZ(1))
      REAL U00023(SSZ(4),SSZ(3),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VNDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00023(I00001,I00004,I00002)=C00023(I00001,I00004,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004))),I00002)/100.0 +V00025(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00023),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(23),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    C00023,U00023,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VNDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01171')
      RETURN
      END
      SUBROUTINE S01172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00024,
     *  V00026,V00027,
     *  U00024,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(1))
      REAL V00026(SSZ(2),SSZ(1))
      REAL V00027(SSZ(2),SSZ(1))
      REAL U00024(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00024(I00001,I00002)=C00024(I00001,I00002)*
     *  (V00026(I00001,I00002)/100.0 +V00027(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00024),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(24),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00024,U00024,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01172')
      RETURN
      END
      SUBROUTINE S01173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00025,
     *  V00027,V00028,
     *  U00025,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00025(SSZ(2),SSZ(1))
      REAL V00027(SSZ(2),SSZ(1))
      REAL V00028(SSZ(2),SSZ(1))
      REAL U00025(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00025(I00001,I00002)=C00025(I00001,I00002)*
     *  (V00028(I00001,I00002)/100.0 +V00027(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00025),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(25),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00025,U00025,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIPF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01173')
      RETURN
      END
      SUBROUTINE S01174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00026,
     *  V00014,V00029,
     *  U00026,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(1))
      REAL V00014(SSZ(2),SSZ(1))
      REAL V00029(SSZ(2),SSZ(1))
      REAL U00026(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00026(I00001,I00002)=C00026(I00001,I00002)*
     *  (V00014(I00001,I00002)/100.0 +V00029(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00026),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(26),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00026,U00026,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01174')
      RETURN
      END
      SUBROUTINE S01175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00027,
     *  V00030,V00031,
     *  U00027,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00027(SSZ(4),SSZ(1))
      REAL V00030(SSZ(4),SSZ(1))
      REAL V00031(SSZ(4),SSZ(1))
      REAL U00027(SSZ(4),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "IPMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      U00027(I00001,I00002)=C00027(I00001,I00002)*
     *  (V00030(I00001,I00002)/100.0 +V00031(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00027),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(27),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(4),SSZ(1),1,1,
     *    1,1,1,
     *    C00027,U00027,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "IPMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01175')
      RETURN
      END
      SUBROUTINE S01176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00028,
     *  V00006,V00032,
     *  U00028,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00028(SSZ(4),SSZ(3),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00032(SSZ(4),SSZ(3),SSZ(1))
      REAL U00028(SSZ(4),SSZ(3),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VNIP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00028(I00001,I00004,I00002)=C00028(I00001,I00004,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004))),I00002)/100.0 +V00032(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00028),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(28),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(1),1,
     *    1,1,1,
     *    C00028,U00028,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VNIP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01176')
      RETURN
      END
      SUBROUTINE S01177(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00029,
     *  V00033,V00034,
     *  U00029,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00029(SSZ(6),SSZ(1))
      REAL V00033(SSZ(9),SSZ(1))
      REAL V00034(SSZ(9),SSZ(1))
      REAL U00029(SSZ(6),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      U00029(I00001,I00002)=C00029(I00001,I00002)*
     *  (V00033(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00002)/100.0 +V00034(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-
     *  1+I00001)),I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00029),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(29),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(6),SSZ(1),1,1,
     *    1,1,1,
     *    C00029,U00029,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "EVOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01177')
      RETURN
      END
      SUBROUTINE S01178(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00030,
     *  V00035,V00036,
     *  U00030,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00030(SSZ(6),SSZ(7),SSZ(1))
      REAL V00035(SSZ(6),SSZ(7),SSZ(1))
      REAL V00036(SSZ(6),SSZ(7),SSZ(1))
      REAL U00030(SSZ(6),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      U00030(I00001,I00005,I00002)=C00030(I00001,I00005,I00002)*
     *  (V00035(I00001,I00005,I00002)/100.0 +
     *  V00036(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00030),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(30),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00030,U00030,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "EVFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01178')
      RETURN
      END
      SUBROUTINE S01179(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00031,
     *  V00037,V00038,
     *  U00031,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00031(SSZ(2),SSZ(7),SSZ(1))
      REAL V00037(SSZ(2),SSZ(7),SSZ(1))
      REAL V00038(SSZ(2),SSZ(7),SSZ(1))
      REAL U00031(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00031(I00001,I00005,I00002)=C00031(I00001,I00005,I00002)*
     *  (V00037(I00001,I00005,I00002)/100.0 +
     *  V00038(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00031),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(31),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00031,U00031,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01179')
      RETURN
      END
      SUBROUTINE M00026(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 GTAPM_c1
      USE GTAPM_u1
      USE GTAPM_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 S01154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00001,
     *  U00001,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,
     *  V00001,V00002,
     *  U00008,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00009,
     *  V00003,V00004,
     *  U00009,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00009),U00009,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDGF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00010,
     *  V00004,V00005,
     *  U00010,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VDGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00011,
     *  V00006,V00007,
     *  U00011,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'DGMARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00012,
     *  V00008,V00009,
     *  U00012,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VNDG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00013,
     *  V00006,V00010,
     *  U00013,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00014,
     *  V00011,V00012,
     *  U00014,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VIGF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00015,
     *  V00012,V00013,
     *  U00015,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VIGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00016,
     *  V00014,V00015,
     *  U00016,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'IGMARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00017,
     *  V00016,V00017,
     *  U00017,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VNIG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00018,
     *  V00006,V00018,
     *  U00018,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00019,
     *  V00019,V00020,
     *  U00019,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VDPF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00020,
     *  V00020,V00021,
     *  U00020,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VDPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00021,
     *  V00006,V00022,
     *  U00021,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'DPMARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00022,
     *  V00023,V00024,
     *  U00022,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VNDP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00023,
     *  V00006,V00025,
     *  U00023,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00024,
     *  V00026,V00027,
     *  U00024,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VIPF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00025,
     *  V00027,V00028,
     *  U00025,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VIPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00026,
     *  V00014,V00029,
     *  U00026,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'IPMARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00027,
     *  V00030,V00031,
     *  U00027,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VNIP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00028,
     *  V00006,V00032,
     *  U00028,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'EVOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01177(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00029,
     *  V00033,V00034,
     *  U00029,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'EVFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01178(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00030,
     *  V00035,V00036,
     *  U00030,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VDFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01179(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00031,
     *  V00037,V00038,
     *  U00031,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00026')
      RETURN
      END
      SUBROUTINE S01180(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00032,
     *  V00038,V00039,
     *  U00032,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(7),SSZ(1))
      REAL V00038(SSZ(2),SSZ(7),SSZ(1))
      REAL V00039(SSZ(2),SSZ(7),SSZ(1))
      REAL U00032(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00032(I00001,I00005,I00002)=C00032(I00001,I00005,I00002)*
     *  (V00039(I00001,I00005,I00002)/100.0 +
     *  V00038(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00032),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(32),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00032,U00032,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01180')
      RETURN
      END
      SUBROUTINE S01181(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00033,
     *  V00006,V00040,
     *  U00033,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(7),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00040(SSZ(2),SSZ(7),SSZ(1))
      REAL U00033(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00033(I00001,I00005,I00002)=C00033(I00001,I00005,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00040(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00033),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(33),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00033,U00033,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01181')
      RETURN
      END
      SUBROUTINE S01182(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,
     *  V00041,V00042,
     *  U00034,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00034(SSZ(4),SSZ(7),SSZ(1))
      REAL V00041(SSZ(4),SSZ(7),SSZ(1))
      REAL V00042(SSZ(4),SSZ(7),SSZ(1))
      REAL U00034(SSZ(4),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "DFMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(4)
      U00034(I00001,I00005,I00002)=C00034(I00001,I00005,I00002)*
     *  (V00041(I00001,I00005,I00002)/100.0 +
     *  V00042(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00034),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(34),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(4),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00034,U00034,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "DFMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01182')
      RETURN
      END
      SUBROUTINE S01183(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00035,
     *  V00006,V00043,
     *  U00035,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00035(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00043(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL U00035(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VNDF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00002=1,SSZ(1)
      DO 3 I00005=1,SSZ(7)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00035(I00001,I00004,I00005,I00002)=
     *  C00035(I00001,I00004,I00005,I00002)*(V00006(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+I00004))),I00002)/100.0 +
     *  V00043(I00001,I00004,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00035),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(35),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(7),SSZ(1),
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(7),SSZ(1),
     *    1,1,1,
     *    C00035,U00035,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VNDF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01183')
      RETURN
      END
      SUBROUTINE S01184(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00036,
     *  V00044,V00045,
     *  U00036,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00036(SSZ(2),SSZ(7),SSZ(1))
      REAL V00044(SSZ(2),SSZ(7),SSZ(1))
      REAL V00045(SSZ(2),SSZ(7),SSZ(1))
      REAL U00036(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00036(I00001,I00005,I00002)=C00036(I00001,I00005,I00002)*
     *  (V00044(I00001,I00005,I00002)/100.0 +
     *  V00045(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00036),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(36),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00036,U00036,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01184')
      RETURN
      END
      SUBROUTINE S01185(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00037,
     *  V00006,V00036,V00046,
     *  U00037,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00037(SSZ(6),SSZ(7),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00036(SSZ(6),SSZ(7),SSZ(1))
      REAL V00046(SSZ(10),SSZ(7),SSZ(1))
      REAL U00037(SSZ(6),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPCVAR(
     *  SSZ(6),SSZ(7),SSZ(1),1,
     *  1,1,1,
     *  U00037,0.0,1,1,1,1,1,1,1,
     *  SSZ(6),SSZ(7),SSZ(1),1,
     *  1,1,1,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(11)
      U00037(SSMP(SSMPST(11)-1+I00001),I00005,I00002)=
     *  C00037(SSMP(SSMPST(11)-1+I00001),I00005,I00002)*
     *  (V00006(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001))),I00002)/100.0 +V00036(SSMP(SSMPST(11)-1+
     *  I00001),I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      DO 6 I00002=1,SSZ(1)
      DO 5 I00005=1,SSZ(7)
      DO 4 I00001=1,SSZ(10)
      U00037(SSMP(SSMPST(10)-1+I00001),I00005,I00002)=
     *  C00037(SSMP(SSMPST(10)-1+I00001),I00005,I00002)*
     *  (V00046(I00001,I00005,I00002)/100.0 +V00036(SSMP(SSMPST(10)-1+
     *  I00001),I00005,I00002)/100.0 )
    4 CONTINUE
    5 CONTINUE
    6 CONTINUE
      CALL GPARW(SIZE(C00037),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(37),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00037,U00037,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01185')
      RETURN
      END
      SUBROUTINE S01186(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00038,
     *  V00045,V00047,
     *  U00038,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL V00045(SSZ(2),SSZ(7),SSZ(1))
      REAL V00047(SSZ(2),SSZ(7),SSZ(1))
      REAL U00038(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00038(I00001,I00005,I00002)=C00038(I00001,I00005,I00002)*
     *  (V00047(I00001,I00005,I00002)/100.0 +
     *  V00045(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00038),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(38),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00038,U00038,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01186')
      RETURN
      END
      SUBROUTINE S01187(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00039,
     *  V00014,V00048,
     *  U00039,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00039(SSZ(2),SSZ(7),SSZ(1))
      REAL V00014(SSZ(2),SSZ(1))
      REAL V00048(SSZ(2),SSZ(7),SSZ(1))
      REAL U00039(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00039(I00001,I00005,I00002)=C00039(I00001,I00005,I00002)*
     *  (V00014(I00001,I00002)/100.0 +
     *  V00048(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00039),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(39),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00039,U00039,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01187')
      RETURN
      END
      SUBROUTINE S01188(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00040,
     *  V00049,V00050,
     *  U00040,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00040(SSZ(4),SSZ(7),SSZ(1))
      REAL V00049(SSZ(4),SSZ(7),SSZ(1))
      REAL V00050(SSZ(4),SSZ(7),SSZ(1))
      REAL U00040(SSZ(4),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "IFMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(7)
      DO 1 I00001=1,SSZ(4)
      U00040(I00001,I00005,I00002)=C00040(I00001,I00005,I00002)*
     *  (V00049(I00001,I00005,I00002)/100.0 +
     *  V00050(I00001,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00040),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(40),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(4),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00040,U00040,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "IFMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01188')
      RETURN
      END
      SUBROUTINE S01189(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00041,
     *  V00006,V00051,
     *  U00041,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00051(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      REAL U00041(SSZ(4),SSZ(3),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VNIF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00002=1,SSZ(1)
      DO 3 I00005=1,SSZ(7)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00041(I00001,I00004,I00005,I00002)=
     *  C00041(I00001,I00004,I00005,I00002)*(V00006(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+I00004))),I00002)/100.0 +
     *  V00051(I00001,I00004,I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00041),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(41),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(7),SSZ(1),
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(7),SSZ(1),
     *    1,1,1,
     *    C00041,U00041,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VNIF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01189')
      RETURN
      END
      SUBROUTINE S01190(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00042,
     *  V00006,V00052,
     *  U00042,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00042(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00052(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      REAL U00042(SSZ(3),SSZ(4),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VNDX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00005=1,SSZ(4)
      DO 1 I00004=1,SSZ(3)
      U00042(I00004,I00005,I00002,I00003)=
     *  C00042(I00004,I00005,I00002,I00003)*(V00006(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+I00004))),I00002)/100.0 +
     *  V00052(I00004,I00005,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00042),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(42),KSTEP,NSTEP,METHOD,
     *    SSZ(3),SSZ(4),SSZ(1),SSZ(1),
     *    1,1,1,
     *    SSZ(3),SSZ(4),SSZ(1),SSZ(1),
     *    1,1,1,
     *    C00042,U00042,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VNDX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01190')
      RETURN
      END
      SUBROUTINE S01191(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00043,
     *  V00053,V00054,
     *  U00043,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00043(SSZ(4),SSZ(1),SSZ(1))
      REAL V00053(SSZ(4),SSZ(1),SSZ(1))
      REAL V00054(SSZ(4),SSZ(1),SSZ(1))
      REAL U00043(SSZ(4),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "XMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(4)
      U00043(I00005,I00002,I00003)=C00043(I00005,I00002,I00003)*
     *  (V00053(I00005,I00002,I00003)/100.0 +
     *  V00054(I00005,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00043),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(43),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(4),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00043,U00043,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "XMARG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01191')
      RETURN
      END
      SUBROUTINE S01192(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00044,
     *  V00006,V00055,
     *  U00044,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00044(SSZ(2),SSZ(1),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00055(SSZ(2),SSZ(1),SSZ(1))
      REAL U00044(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00044(I00001,I00002,I00003)=C00044(I00001,I00002,I00003)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00055(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00044),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(44),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00044,U00044,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01192')
      RETURN
      END
      SUBROUTINE S01193(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00045,
     *  V00056,V00057,
     *  U00045,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00045(SSZ(2),SSZ(1),SSZ(1))
      REAL V00056(SSZ(2),SSZ(1),SSZ(1))
      REAL V00057(SSZ(2),SSZ(1),SSZ(1))
      REAL U00045(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXFD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00045(I00001,I00002,I00003)=C00045(I00001,I00002,I00003)*
     *  (V00056(I00001,I00002,I00003)/100.0 +
     *  V00057(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00045),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(45),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00045,U00045,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VXFD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01193')
      RETURN
      END
      SUBROUTINE S01194(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00046,
     *  V00058,V00059,
     *  U00046,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00046(SSZ(1))
      REAL V00058(SSZ(1))
      REAL V00059(SSZ(1))
      REAL U00046(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00046(I00002)=C00046(I00002)*(V00058(I00002)/100.0 +
     *  V00059(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00046),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(46),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00046,U00046,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01194')
      RETURN
      END
      SUBROUTINE S01195(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00047,
     *  V00057,V00060,
     *  U00047,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00047(SSZ(2),SSZ(1),SSZ(1))
      REAL V00057(SSZ(2),SSZ(1),SSZ(1))
      REAL V00060(SSZ(2),SSZ(1),SSZ(1))
      REAL U00047(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIMS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00047(I00001,I00002,I00003)=C00047(I00001,I00002,I00003)*
     *  (V00060(I00001,I00002,I00003)/100.0 +
     *  V00057(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00047),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(47),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00047,U00047,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIMS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01195')
      RETURN
      END
      SUBROUTINE S01196(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00048,
     *  V00057,V00061,
     *  U00048,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1),SSZ(1))
      REAL V00057(SSZ(2),SSZ(1),SSZ(1))
      REAL V00061(SSZ(2),SSZ(1),SSZ(1))
      REAL U00048(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIWS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00048(I00001,I00002,I00003)=C00048(I00001,I00002,I00003)*
     *  (V00061(I00001,I00002,I00003)/100.0 +
     *  V00057(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00048),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(48),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00048,U00048,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIWS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01196')
      RETURN
      END
      SUBROUTINE S01197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00049,
     *  V00057,V00062,
     *  U00049,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00049(SSZ(2),SSZ(1),SSZ(1))
      REAL V00057(SSZ(2),SSZ(1),SSZ(1))
      REAL V00062(SSZ(2),SSZ(1),SSZ(1))
      REAL U00049(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXWD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00049(I00001,I00002,I00003)=C00049(I00001,I00002,I00003)*
     *  (V00062(I00001,I00002,I00003)/100.0 +
     *  V00057(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00049),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(49),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00049,U00049,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VXWD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01197')
      RETURN
      END
      SUBROUTINE S01198(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00050,
     *  V00006,V00063,
     *  U00050,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00050(SSZ(3),SSZ(1))
      REAL V00006(SSZ(9),SSZ(1))
      REAL V00063(SSZ(3),SSZ(1))
      REAL U00050(SSZ(3),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(3)
      U00050(I00004,I00002)=C00050(I00004,I00002)*
     *  (V00006(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00004))),I00002)/100.0 +V00063(I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00050),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(50),KSTEP,NSTEP,METHOD,
     *    SSZ(3),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(3),SSZ(1),1,1,
     *    1,1,1,
     *    C00050,U00050,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01198')
      RETURN
      END
      SUBROUTINE S01210(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00117,
     *  V00058,V00059,
     *  U00117,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00117(SSZ(1))
      REAL V00058(SSZ(1))
      REAL V00059(SSZ(1))
      REAL U00117(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VKB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00117(I00002)=C00117(I00002)*(V00059(I00002)/100.0 +
     *  V00058(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00117),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(117),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00117,U00117,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VKB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01210')
      RETURN
      END
      SUBROUTINE M00027(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 GTAPM_c1
      USE GTAPM_u1
      USE GTAPM_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''',
     *    'VDFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01180(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00032,
     *  V00038,V00039,
     *  U00032,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VDFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01181(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00033,
     *  V00006,V00040,
     *  U00033,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'DFMARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01182(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,
     *  V00041,V00042,
     *  U00034,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VNDF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01183(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00035,
     *  V00006,V00043,
     *  U00035,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01184(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00036,
     *  V00044,V00045,
     *  U00036,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    '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 S01185(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00037,
     *  V00006,V00036,V00046,
     *  U00037,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VIFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01186(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00038,
     *  V00045,V00047,
     *  U00038,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VIFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01187(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00039,
     *  V00014,V00048,
     *  U00039,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'IFMARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01188(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00040,
     *  V00049,V00050,
     *  U00040,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VNIF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01189(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00041,
     *  V00006,V00051,
     *  U00041,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'VNDX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01190(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00042,
     *  V00006,V00052,
     *  U00042,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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''',
     *    'XMARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01191(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00043,
     *  V00053,V00054,
     *  U00043,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00043),U00043,
     *  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 S01192(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00044,
     *  V00006,V00055,
     *  U00044,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00044),U00044,
     *  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''',
     *    'VXFD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01193(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00045,
     *  V00056,V00057,
     *  U00045,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00045),U00045,
     *  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 S01194(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00046,
     *  V00058,V00059,
     *  U00046,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00046),U00046,
     *  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 S01195(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00047,
     *  V00057,V00060,
     *  U00047,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00047),U00047,
     *  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 S01196(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00048,
     *  V00057,V00061,
     *  U00048,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00048),U00048,
     *  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 S01197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00049,
     *  V00057,V00062,
     *  U00049,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00049),U00049,
     *  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 S01198(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00050,
     *  V00006,V00063,
     *  U00050,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00050),U00050,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01210(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00117,
     *  V00058,V00059,
     *  U00117,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00027')
      RETURN
      END
      SUBROUTINE S01216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00128,
     *  V00148,V00157,
     *  U00128,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00148(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00157(SSZ(3))
      REAL U00128(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VTMFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00004=1,SSZ(3)
      U00128(I00004,I00001,I00002,I00003)=
     *  C00128(I00004,I00001,I00002,I00003)*(V00157(I00004)/100.0 +
     *  V00148(I00004,I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00128),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(128),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,
     *    C00128,U00128,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VTMFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01216')
      RETURN
      END
      SUBROUTINE S01218(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00149,
     *  V00169,
     *  U00149,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00149(SSZ(1))
      REAL V00169(SSZ(1))
      REAL U00149(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "DPARSUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00149(I00002)=C00149(I00002)*(V00169(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00149),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(149),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00149,U00149,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "DPARSUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01218')
      RETURN
      END
      SUBROUTINE S01219(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00154,
     *  V00074,
     *  U00154,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00154(SSZ(1))
      REAL V00074(SSZ(1))
      REAL U00154(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00154(I00002)=C00154(I00002)*(V00074(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00154),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(154),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00154,U00154,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01219')
      RETURN
      END
      SUBROUTINE S01220(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00155,
     *  V00070,
     *  U00155,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00155(SSZ(1))
      REAL V00070(SSZ(1))
      REAL U00155(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00155(I00002)=C00155(I00002)*(V00070(I00002)/100.0 )
    1 CONTINUE
      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
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01220')
      RETURN
      END
      SUBROUTINE S01221(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00156,
     *  V00002,V00065,
     *  U00156,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00156(SSZ(1))
      REAL V00002(SSZ(1))
      REAL V00065(SSZ(1))
      REAL U00156(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00156(I00002)=((V00002(I00002)-V00065(I00002))/100.)*
     *  C00156(I00002)
    1 CONTINUE
      CALL GPARW(SIZE(C00156),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(156),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00156,U00156,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01221')
      RETURN
      END
      SUBROUTINE S01222(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00190,
     *  V00221,
     *  U00190,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00190(SSZ(1))
      REAL V00221(SSZ(1))
      REAL U00190(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00190(I00002)=C00190(I00002)*(V00221(I00002)/100.0 )
    1 CONTINUE
      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
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01222')
      RETURN
      END
      SUBROUTINE S01223(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00191,
     *  V00219,
     *  U00191,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00191(SSZ(1))
      REAL V00219(SSZ(1))
      REAL U00191(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00191(I00002)=C00191(I00002)*(V00219(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00191),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(191),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00191,U00191,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01223')
      RETURN
      END
      SUBROUTINE S01224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00192,
     *  V00218,
     *  U00192,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00192(SSZ(1))
      REAL V00218(SSZ(1))
      REAL U00192(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00192(I00002)=C00192(I00002)*(V00218(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00192),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(192),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00192,U00192,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01224')
      RETURN
      END
      SUBROUTINE S01225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00193,
     *  V00065,V00220,
     *  U00193,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00193(SSZ(1))
      REAL V00065(SSZ(1))
      REAL V00220(SSZ(1))
      REAL U00193(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00193(I00002)=((V00220(I00002)-V00065(I00002))/100.)*
     *  C00193(I00002)
    1 CONTINUE
      CALL GPARW(SIZE(C00193),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(193),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00193,U00193,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01225')
      RETURN
      END
      SUBROUTINE S01226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00194,
     *  V00224,
     *  U00194,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00194(SSZ(2),SSZ(1))
      REAL V00224(SSZ(2),SSZ(1))
      REAL U00194(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00194(I00001,I00002)=C00194(I00001,I00002)*
     *  (V00224(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00194),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(194),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00194,U00194,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01226')
      RETURN
      END
      SUBROUTINE S01227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00200,
     *  V00222,
     *  U00200,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00200(SSZ(1))
      REAL V00222(SSZ(1))
      REAL U00200(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00200(I00002)=C00200(I00002)*(V00222(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00200),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(200),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00200,U00200,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01227')
      RETURN
      END
      SUBROUTINE S01228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00201,
     *  V00223,
     *  U00201,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00201(SSZ(1))
      REAL V00223(SSZ(1))
      REAL U00201(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00201(I00002)=C00201(I00002)*(V00223(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00201),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(201),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00201,U00201,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01228')
      RETURN
      END
      SUBROUTINE S01229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00202,
     *  V00225,
     *  U00202,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00202(SSZ(1))
      REAL V00225(SSZ(1))
      REAL U00202(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00202(I00002)=C00202(I00002)*(V00225(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00202),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(202),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00202,U00202,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01229')
      RETURN
      END
      SUBROUTINE S01230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00206,
     *  V00216,
     *  U00206,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00206(SSZ(1))
      REAL V00216(SSZ(1))
      REAL U00206(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00206(I00002)=C00206(I00002)*(V00216(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00206),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(206),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00206,U00206,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01230')
      RETURN
      END
      SUBROUTINE M00028(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 GTAPM_c1
      USE GTAPM_u1
      USE GTAPM_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(U00117),U00117,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VTMFSD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00128,
     *  V00148,V00157,
     *  U00128,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00128),U00128,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01218(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00149,
     *  V00169,
     *  U00149,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01219(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00154,
     *  V00074,
     *  U00154,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01220(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00155,
     *  V00070,
     *  U00155,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01221(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00156,
     *  V00002,V00065,
     *  U00156,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01222(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00190,
     *  V00221,
     *  U00190,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01223(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00191,
     *  V00219,
     *  U00191,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00192,
     *  V00218,
     *  U00192,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00193,
     *  V00065,V00220,
     *  U00193,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00194,
     *  V00224,
     *  U00194,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00200,
     *  V00222,
     *  U00200,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00201,
     *  V00223,
     *  U00201,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00202,
     *  V00225,
     *  U00202,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,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 S01230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00206,
     *  V00216,
     *  U00206,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,ECHO1,
     *  AXSUN,RDUN,WRUN,0,CWKUN,MMNST,SSZ,SZUB,
     *  LFNORD,LFNOWR,LFFOWR,MMNFL,AFN,AFS,NUMFL,RDFSNO,WRFSNO,FLRLS,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,MMNRD,RDTXOR,RDLNM,.FALSE.,
     *  NUMST,STLB,STELHD,STNM,STELST,ELAD,STPOSTSIM,MMEL,STEL,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  DSSMP,SSMP,MMNIG,DOIG,MMNSS,SSIOS,SSMPST,SUVFI,
     *  TMPLG1,TMPI1,MMNCS,CSPOS,CSDIM,UCWKST,CSPOSTSIM,
     *  MMNVC,VCWKST,VCDIM,NUMRD,RDCSN,CSLB,RDARG,IGTP,
     *  FLFM,RDFLN,RDINIT,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00028')
      RETURN
      END
      SUBROUTINE GPEQN1(EQNUM,CHAR,LCHAR,ERRMES)
      use gsinc1
      use gsinc3
      use gsinc5
      INTEGER EQNUM,LCHAR
      CHARACTER*(*) CHAR,ERRMES
      CALL GPEQN0(EQNUM,
     *  .TRUE.,MMNST,NUMST,SSZ,STELST,ELAD,.TRUE.,MMEL,STEL,
     *  .TRUE.,MMNEQ,NUMEQ,EQNAM,EQNIND,EQSTAT,.TRUE.,
     *  DEQSTN,EQSTN,CHAR,LCHAR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('GPEQN1')
      RETURN
      END
      include 'tgrwcv1.for'
      USE GTAPM_c3
      USE GTAPM_c4
      include 'tgrwcv2.for'
      include 'tgwdwk1.for'
      USE GTAPM_c3
      include 'tgwdwk2.for'
      include 'tgscrs1.for'
      USE GTAPM_c3
      USE GTAPM_c4
      USE GTAPM_u2
      include 'tgscrs2.for'
      include 'tgst1.for'
      USE GTAPM_c3
      include 'tgst2.for'
      include 'tgwacv1.for'
      USE GTAPM_c3
      include 'tgwacv2.for'
      include 'tgwcvv1.for'
      USE GTAPM_c3
      include 'tgwcvv2.for'
      include 'tgctri1.for'
      USE GTAPM_c3
      include 'tgctri2.for'
      include 'tgutv1.for'
      USE GTAPM_u2
      include 'tgutv2.for'
      include 'ssrsmv1.for'
      USE GTAPM_c3
      include 'ssrsmv2.for'
      include 'tgpmp1.for'
      USE GTAPM_c4
      include 'tgpmp2.for'
      include 'cmchsh1.for'
      USE GTAPM_c3
      include 'cmchsh2.for'
      include 'tbsstp1.for'
      USE gsinc5
      include 'tbsstp2.for'
      include 'tbsssp1.for'
      USE gsinc5
      include 'tbsssp2.for'
      include 'tbscsp1.for'
      USE gsinc1
      include 'tbscsp2.for'
