      SUBROUTINE SINTO (JUMP,WORK)
c Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
c ALL RIGHTS RESERVED.
c Based on Government Sponsored Research NAS7-03001.
c>> 2009-07-15 SINTO  Krogh  Fixed incorrect outputs of KDIM
c>> 2008-01-17 SINTO  Krogh  Updated generated error message text.
C>> 2000-12-01 SINTO  Krogh  Removed unused parameters LABSC & MASA16.
C>> 1996-03-31 SINTO  Krogh  Removed unused variable in common.
C>> 1995-11-20 SINTO  Krogh  Converted from SFTRAN to Fortran 77.
C>> 1994-11-17 SINTO  Krogh  Rearranged parameter statments.
C>> 1994-11-14 SINTO  Krogh  Declared all vars.
c>> 1994-10-19 SINTO  Krogh  Changes to use M77CON
c>> 1994-07-07 SINTO  Snyder set up for CHGTYP.
C>> 1994-06-13 SINTO  Krogh -- Fixed value of LLOC3 "+2" not "+3".
C>> 1993-05-18 SINTO  Krogh -- Changed "END" to "END PROGRAM"
c>> 1993-04-29 SINTO  Krogh  Additions for Conversion to C.
C>> 1993-04-13 SINTO  Krogh  Minor changes for new MESS.
C>> 1992-05-28 SINTO  Krogh  Corrected minor problem in error message.
C>> 1992-04-08 SINTO  Krogh unused label 210, FDAT in MESS calls removed
C>> 1992-03-03 SINTO  Krogh converted to use message processor.
C>> 1991-09-20 SINTO  Krogh converted '(1)' dimensioning to '(*)'.
C>> 1988-11-17 SINTO  Snyder  Remove unnecessary specializer comments.
C>> 1988-06-07 SINTO  Snyder  Correct format statement 20.
C>> 1987-11-19 SINTO  Snyder  Initial code.
C
C     PRINT SOMETHING FOR SINTA.
c
c--S replaces "?": ?INT, ?INTA, ?intc, ?intec, ?INTNC, ?INTO, ?MESS
C
C     *****     DESCRIPTION OF VARIABLES WITH SPECIAL USE HERE *********
C
C AACUM  First floating point variable in saved common area.
C ACUM   Double precision result accumulated.
C AINIT  First floating point variable in the unsaved common area.
C DISCHK Nonzero if checking for a discontinuity.  This and WORRY are
C        only printed if DISCHK is not zero.
C SMESS  Used when message contains floating point.
C FDAT   Temporary storage for floating point variables to be printed.
C FNSAV  Array equivalenced to AINIT, access to unsaved floating point.
C FSAV   Array equivalenced to AACUM, access to saved floating point.
C I      First integer in the saved common area.
C IDAT   Temporary storage for integer variables to be printed.
C IDFLT1 Parameter, see description of MESSA.
C IDINT1 Parameter, see description of MESSA.
C IDINT2 Parameter, see description of MESSA.
C IF1    Pointer to floating point variable, see MESSA.
C II1    First integer extracted from MESSF, see MESSA.
C II2    Second integer extracted from MESSF, see MESSA.
C INSAV  Array equivalenced to KDIM for access to unsaved integers.
C ISAV   Array equivalenced to I for access to saved integers.
C JUMP   Input variable defining what is to be printed.
C    = 1 Panel boundaries
C    = 2 Header (if needed) and K, ERRI, ERR, EPSMIN, EPS, RE, ...
C    = 3 No action.
C    = 4 Note that direction of accumulation has been reversed.
C    = 5 x's, f's, difference lines, etc.
C    = 6 Estimated errors during a search.
C    = 7 Panel boundaries after a disconinuity found.
C    = 8 New round off level after noise detected.
C    = 9 Indicate a nonintegrable singularity.
C    =10 Note that abscissae have coalesced.
C    =11 Data for an accepted answer.
C    =12 Step size from an initial interval search.
C    =13 Message that there appears to be a discontinuity.
C KDIM   First integer variable in the unsaved common area.
C L??    Many names starting with L identify the locations of variables
C        the common blocks.  The letters following the L serve to
C        identify which variable in the common blocks.  All of these
C        variables are defined in a block of parameter statements
C        separated from others by header and ending comments.
C LENDT  Number of x's, f,s and differences to be printed.
C LIDAT  Current location for saving integers in IDAT.
C LMACT  Current base location for saving data in MACT.
C LMESS  Value taken from MESSL and updated depending on MESSF, see
C        description of MESSA below.  If > 0, provides an index
C        into MESSA for the action.  After getting actions, if this
C        is > 1, it gives the next value of LMESS; else data is printed
C        and a return is made with printout of exterior abscissae
C        following the other data if LMESS is 1.  If LMESS < 0, -LMESS
C        is packed data like that in MESSA, except that in this case
C        II1 gives the next value to be assigned to LMESS, and both the
C        integer and floating point data is to be printed from the
C        unsaved common block.
C LTXTA? All names of this type were generated by running the data in
C        SINTO.ERR through PMESS.  These are all parameters that define
C        where various text starts in MTXTAx.
C MACT   Array used to store actions for calls to MESS.
C MACTAR As for MACT except for printing a vector.
C MACTH  As for MACT except only need pointer to one text entry.
C MACTMA As for MACT except for printing the array containing x's, f's,
C        and differences.
C MECONT Parameter defined in MESS, means return, print is to continue.
C MEFDAT Parameter defined in MESS, means set index for next floating
C        point item to print.
C MEFMAT Parameter defined in MESS, means print a matrix.
C MEFVEC Parameter defined in MESS, means print a vector.
C MENTXT Parameter defined in MESS, as for MEFDAT execpt for text.
C MERET  Parameter defined in MESS, means print buffers and return.
C MESAdd Where dd is one or two digits.  These define parameters that
C        are used in the data statement for MESSA, see comments there.
C MESLd  As for the above, execpt used in assigning value to MESSL, when
C        those value are < 0.
C MESS   Message routine, when no floating point is to be printed.
C MESSA  An array containing packed integers that define the actions to
C        be taken.  Entries in MESSA have the form IDINT1*II1 +
C        IDINT2*II2 + IDFLT1*IF1 + t, where in every case the first
C        multiplier in a product is a parameter which is a power of 2,
C        and the second defines an action as follows:
C    II1  first integer to be printed.  In most cases, LMESS increases
C         by 1, but if this is > 31, LMESS is set to II1 / 32 - 1 and
C         II1 is replaced by mod(II1,32).  If the result is:
C       31 Print out of final results (some vars. are always double
C          precision).
C       30 Check on NDIM to see if KDIM should print.
C       29 Check on DISCHK to decide if it and WORRY are to print.
C      >12 Subtract 12, and use to get an integer from unsaved common.
C      <12 Use to get an integer from the saved common area.
C    II2  Second integer.  Treated like the first, except always < 25.
C    IF1  Used to get a floating point number from the saved common
C         block.
C      t  Location of text for message in MTXTAA.
C MESSF  Obtained from MESSA or -MESSL(LMESS), see above.
C MESSL  Maps value of JUMP into actions.  If > 0, gives an index into
C        MESSA, else the negative defines the value of MESSF.  Also see
C        LMESS above.
C METEXT Parameter defined in MESS, means print as defined by MTXTAx.
C MTXTAx Character arrays containing text and instructions for the
C        printing of messages by MESS.
C NDIM   Number of dimensions in the total integral.
C NEEDH  .TRUE. if heading needed when JUMP is 2, else is .FALSE.
C SMESS  Used when message contains single precision floating point.
C WORK   Array passed in containing exterior abscissae.
C
C     *****     PROGRAM VARIABLES     **********************************
C
      INTEGER JUMP
      REAL                         WORK(*)
      INTEGER         IDAT(5), INSAV(7), ISAV(8), MESSL(13), MESSA(15)
      REAL                         FDAT(4), FNSAV(11), FSAV(169)
      integer LDELMN, LDELTA, LDISCX, LEPS, LERRI, LINC,
     1    LISTOP, LK, LKAIMT, LKDIM, LLOC1, LLOC3, LNFEVA, LNSUB, LPART,
     2    LPHISU, LRNDC, LSEARC, LTPS, LWHERE, LWORRY, LX, LXJ, LXT,
     3    IDFLT1, IDINT2, IDINT1, MESA1, MESA2, MESA3, MESA4, MESA5,
     4    MESA6, MESA7, MESA8, MESA9, MESA10, MESA11, MESA12, MESA13,
     5    MESA14, MESA15, MESL3, MESL5, MESL6, MESL8, MESL9,
     6    MESL13, LMACT, LIDAT, LMESS, MESSF, II1, II2, IF1
C
C     *****     COMMON VARIABLES     ***********************************
C
C     COMMON /SINTNC/ CONTAINS VARIABLES NOT SEPARATELY SAVED FOR
C     EACH DIMENSION OF A MULTIPLE QUADRATURE.  COMMON /SINTC/
C     CONTAINS VARIABLES THAT MUST BE SAVED FOR EACH DIMENSION OF THE
C     QUADRATURE.  THE VARIABLES IN EACH COMMON BLOCK ARE STORED IN THE
C     ORDER - ALWAYS DOUBLE, DOUBLE IF DOUBLE PRECISION PROGRAM, DOUBLE
C     IF DOUBLE PRECISION PROGRAM AND EXPONENT RANGE OF DOUBLE AND
C     SINGLE VERY DIFFERENT, SINGLE, INTEGER, LOGICAL.  A PAD OF LOGICAL
C     VARIABLES IS INCLUDED AT THE END OF /SINTC/.  THE DIMENSION OF
C     THE PAD MAY NEED TO BE VARIED SO THAT NO VARIABLES BEYOND THE END
C     OF THE COMMON BLOCK ARE ALTERED.
C
C     DECLARATIONS OF COMMON /SINTNC/ VARIABLES.
C
      REAL             AINIT, BINIT, FNCVAL, S, TP
      REAL             FER, FER1, RELOBT, TPS, XJ, XJP
      INTEGER     FEA,       FEA1,      INC,       INC2,      IPRINT,
     1 ISTOP(2,2),JPRINT,    KDIM,      KK,        KMAXF,     NDIM,
     2 NFINDX,    NFMAX,     NFMAXM,    RELTOL,    REVERM,    REVERS,
     3 WHEREM
      LOGICAL NEEDH
C
C     DECLARATIONS OF COMMON /SINTC/ VARIABLES.
C
c--D Next line special: S => D, X => Q, D => D, P => D
      DOUBLE PRECISION ACUM, PACUM, RESULT(2)
C     139 $.TYPE.$ VARIABLES
      REAL
     1 AACUM,     ABSCIS,    DELMIN,    DELTA,     DIFF,      DISCX(2),
     2 END(2),    ERRINA,    ERRINB,    FAT(2),    FSAVE,
     3 FUNCT(24), F1,        F2,        LOCAL(4),  PAACUM,    PF1,
     4 PF2,       PHISUM,    PHTSUM,    PX,        SPACE(6),
     5 STEP(2),   START(2),  SUM,       T,         TA,        TASAVE,
     6 TB,        TEND,      WORRY(2),  X,         X1,
     7 X2,        XT(17),    FT(17),    PHI(34)
c Note XT, FT, and PHI above are last, because they must be in adjacent
c locations in SINTC.
C     30 $DSTYP$ VARIABLES
      REAL
     1 ABSDIF,    COUNT,     EDUE2A,    EDUE2B,    EP,        EPNOIZ,
     2 EPS,       EPSMAX,    EPSMIN,    EPSO,      EPSR,      EPSS,
     3 ERR,       ERRAT(2),  ERRC,      ERRF,      ERRI,      ERRT(2),
     4 ESOLD,     EXTRA,     PEPSMN,    RE,        RELEPS,    REP,
     5 REPROD,    RNDC,      TLEN,      XJUMP
C     29 INTEGER VARIABLES
      INTEGER     DISCF,     DISCHK,    ENDPTS,    I,         INEW,
     1 IOLD,      IP,        IXKDIM,    J,         J1,        J1OLD,
     2 J2,        J2OLD,     K,         KAIMT,     KMAX,      KMIN,
     3 L,         LENDT,     NFEVAL,    NFJUMP,    NSUB,      NSUBSV,
     4 NXKDIM,    PART,      SEARCH,    TALOC,     WHERE,     WHERE2
C     11 TO 18 LOGICALS (7 ARE PADDING).
      LOGICAL     DID1,      FAIL,      FATS(2),   FSAVED,    HAVDIF,
     1 IEND,      INIT,      ROUNDF,    XCDOBT(2), PAD(7)
C
C     THE COMMON BLOCKS.
C
      COMMON /SINTNC/
c        1       2       3     4        5       6       7        8
     W AINIT,  BINIT,  FNCVAL, S,      TP,     FER,    FER1,   RELOBT,
c       9      10       11      12      13       1       2        3
     X TPS,    XJ,     XJP,    FEA,    FEA1,   KDIM,    INC,    INC2,
c     4 (2,2)    8       9     10       11      12       13      14
     Y ISTOP,  JPRINT, IPRINT, KK,     KMAXF,  NDIM,   NFINDX, NFMAX,
c        15     16       17      18      19      20
     Z NFMAXM, RELTOL, REVERM, REVERS, WHEREM, NEEDH
      COMMON /SINTC/
     1 ACUM,   PACUM,  RESULT
      COMMON /SINTC/
c        1     2 (4)     6      7        8       9      10     11 (2)
     1 AACUM,  LOCAL,  ABSCIS, TA,     DELTA,  DELMIN, DIFF,   DISCX,
c     13 (2)     15      16    17 (2)   19     20 (24) 44
     2 END,    ERRINA, ERRINB, FAT,    FSAVE,  FUNCT,  F2,
c       45      46     47       48      49     50      51 (6)
     3 PAACUM, PF1,    PF2,    PHISUM, PHTSUM, PX,     SPACE,
c      57 (2)  59 (2)   61     62        63    64       65
     4 STEP,   START,  SUM,    T,      TASAVE, TB,     TEND,
c      66 (2)  68      69      70      71       72
     5 WORRY,  X1,     X2,     X,      F1,     COUNT,
c      73 (17) 90 (17) 107 (34)
     6 XT,     FT,     PHI
      COMMON /SINTC/
c       141     142    143     144      145     146
     1 ABSDIF, EDUE2A, EDUE2B, EP,     EPNOIZ, EPSMAX,
c       147     148     149    150 (2)  152     153
     2 EPSO,   EPSR,   EPSS,   ERRAT,  ERRC,   ERRF,
c     154 (2)   156     157     158     159    160
     3 ERRT,   ESOLD,  EXTRA,  PEPSMN, RELEPS, REP,
c       161     162     163
     4 RNDC,   TLEN,   XJUMP,
c       164    165      166    167    168       169
     5 ERRI,   ERR,    EPSMIN, EPS,    RE,     REPROD
      COMMON /SINTC/
c       170     171     172
     1 DISCF,  DISCHK, ENDPTS, INEW,   IOLD,   IP,     IXKDIM,
     2 J,      J1,     J1OLD,  J2,     J2OLD,  KMAX,   KMIN,
     3 L,      LENDT,  NFJUMP, NSUBSV, NXKDIM, TALOC,  WHERE2,
c      1       2          3      4       5         6      7       8
     4 I,      K,      KAIMT,  NSUB,   PART,   SEARCH, WHERE, NFEVAL
      COMMON /SINTC/
     1 DID1,   FAIL,   FATS,   FSAVED, HAVDIF, IEND,   INIT,   ROUNDF,
     2 XCDOBT, PAD
      SAVE /SINTNC/, /SINTC/
C
C     THE VARIABLES HERE DEFINE THE MACHINE ENVIRONMENT.  ALL ARE SET
C     IN DINTOP.  THE MEANING ATTACHED TO THESE VARIABLES CAN BE
C     FOUND BY LOOKING AT THE DEFINITIONS IN DINTOP.
      REAL
     1  EMEPS,  EEPSM8, EDELM2, EDELM3, ESQEPS, ERSQEP, ERSQE6, EMINF,
     2  ESMALL, ENZER,  EDELM1, ENINF
      COMMON /SINTEC/
     1  EMEPS,  EEPSM8, EDELM2, EDELM3, ESQEPS, ERSQEP, ERSQE6, EMINF,
     2  ESMALL, ENZER,  EDELM1, ENINF
      SAVE /SINTEC/
C
C     *****     EQUIVALENCE STATEMENTS     *****************************
C
      EQUIVALENCE (INSAV,KDIM), (FNSAV,AINIT), (ISAV,I), (FSAV,AACUM)
C
C     *****    Statements for Processing Messages **********************
C
      INTEGER MENTXT, MEFDAT, MECONT, MERET, MEEMES, METEXT, MEFVEC,
     1    MEFMAT
      PARAMETER (MENTXT =23)
      PARAMETER (MEFDAT =25)
      PARAMETER (MECONT =50)
      PARAMETER (MERET  =51)
      PARAMETER (MEEMES =52)
      PARAMETER (METEXT =53)
      PARAMETER (MEFVEC =61)
      PARAMETER (MEFMAT =62)
      INTEGER MACT(26), MACTMA(7), MACTAR(6), MACTH(2), MACTER(5)
C Parameters defining locations in the common blocks.
      PARAMETER (LTPS=9)
      PARAMETER (LXJ=10)
c
      PARAMETER (LINC=2)
      PARAMETER (LISTOP=4)
      PARAMETER (LKDIM=1)
c
      PARAMETER (LDELMN=9)
      PARAMETER (LDELTA=8)
      PARAMETER (LDISCX=11)
      PARAMETER (LEPS=167)
      PARAMETER (LERRI=164)
      PARAMETER (LPHISU=48)
      PARAMETER (LRNDC=161)
      PARAMETER (LWORRY=66)
      PARAMETER (LX=70)
      PARAMETER (LXT=73)
c
      PARAMETER (LK=2)
      PARAMETER (LKAIMT=3)
      PARAMETER (LNSUB=4)
      PARAMETER (LPART=5)
      PARAMETER (LSEARC=6)
      PARAMETER (LWHERE=7)
      PARAMETER (LNFEVA=8)
c
      PARAMETER (LLOC1=2)
      PARAMETER (LLOC3=LLOC1+2)
c
C End of parameters defining locations in the common blocks.
C
c ********* Error message text ***************
c[Last 2 letters of Param. name]  [Text generating message.]
cAA NSUB=$I on ($F, $F) KDIM=$I$B
cAB  DEL=$(E12.5) DELMIN=$(E09.3) $B
cAC EPS=$G PART=$I AIM=$I$B
cAD  DISCHK=$I WORRY=$F$B
cAE  KDIM=$I$B
cAF TA=$F$E
cAG $(I2) $(E11.4) $G $G $G $G $G $J$E
cAH **** Reverse Direction ****$E
cAI ISTOP=$I $I $I $I,  XJ=$F XJP=$F$B
cAJ XT$HFT$HPHI$HPHIT$E
cAK $#
cAL INC=$I INC2=$I  E=$F $B
cAM X=$F F1=$F COUNT=$F$E
cAN Round-Off = $F.  $B
cAO Apparent non-integrable singularity near $F.  $B
cAP Absiccae have coalesced.  WHERE=$I, DELMIN=$F, NSUB=$I$E
cAQ DELTA chosen by search = $F.$E
cAR Discontinuity in ($F, $F).$E
cAS Used $I function values -- the maximium.$E
c   $
cAT  K     ERRI        ERR       EPSMIN       EPS  $C
c           RE        REPROD  KDIM$E
c   $
cAU  PHISUM=$F PHTSUM=$F SEARCH=$I$E
c   $
cAV Accept result $I = $F, ACCUM=$F, ERR=$(E10.4), EPSMIN=$G,$C
c    KDIM=$I$E
c   $
cAW Abscissae for dimensions $I to $I: $B
c   $
cAX Really on ($F, $F) KDIM=$I DEL=$(E12.5)     TA=$(E10.3) $E
c   $
cAY SINT$B
      integer LTXTAA,LTXTAB,LTXTAC,LTXTAD,LTXTAE,LTXTAF,LTXTAG,LTXTAH,
     * LTXTAI,LTXTAJ,LTXTAK,LTXTAL,LTXTAM,LTXTAN,LTXTAO,LTXTAP,LTXTAQ,
     * LTXTAR,LTXTAS,LTXTAT,LTXTAU,LTXTAV,LTXTAW,LTXTAX,LTXTAY
      parameter (LTXTAA=  1,LTXTAB= 30,LTXTAC= 62,LTXTAD= 85,LTXTAE=106,
     * LTXTAF=116,LTXTAG=123,LTXTAH=157,LTXTAI=186,LTXTAJ=220,
     * LTXTAK=239,LTXTAL=241,LTXTAM=264,LTXTAN=285,LTXTAO=304,
     * LTXTAP=352,LTXTAQ=409,LTXTAR=439,LTXTAS=467,LTXTAT=  1,
     * LTXTAU=  1,LTXTAV=  1,LTXTAW=  1,LTXTAX=  1,LTXTAY=  1)
      character MTXTAA(3) * (170)
      character MTXTAB(1) * (80)
      character MTXTAC(1) * (32)
      character MTXTAD(1) * (67)
      character MTXTAE(1) * (37)
      character MTXTAF(1) * (58)
      character MTXTAG(1) * (6)
      data MTXTAA/'NSUB=$I on ($F, $F) KDIM=$I$B DEL=$(E12.5) DELMIN=$(E
     *09.3) $BEPS=$G PART=$I AIM=$I$B DISCHK=$I WORRY=$F$B KDIM=$I$BTA=$
     *F$E$(I2) $(E11.4) $G $G $G $G $G $J$E**** Reverse D','irection ***
     **$EISTOP=$I $I $I $I,  XJ=$F XJP=$F$BXT$HFT$HPHI$HPHIT$E$#INC=$I I
     *NC2=$I  E=$F $BX=$F F1=$F COUNT=$F$ERound-Off = $F.  $BApparent no
     *n-integrable singularity n','ear $F.  $BAbsiccae have coalesced. $
     * WHERE=$I, DELMIN=$F, NSUB=$I$EDELTA chosen by search = $F.$EDisco
     *ntinuity in ($F, $F).$EUsed $I function values -- the maximium.$E
     * '/
      data MTXTAB/' K     ERRI        ERR       EPSMIN       EPS       $
     *   RE        REPROD  KDIM$E'/
      data MTXTAC/' PHISUM=$F PHTSUM=$F SEARCH=$I$E'/
      data MTXTAD/'Accept result $I = $F, ACCUM=$F, ERR=$(E10.4), EPSMIN
     *=$G, KDIM=$I$E'/
      data MTXTAE/'Abscissae for dimensions $I to $I: $B'/
      data MTXTAF/'Really on ($F, $F) KDIM=$I DEL=$(E12.5)     TA=$(E10.
     *3) $E'/
      data MTXTAG/'SINT$B'/
c **** End of automatically generated text
      PARAMETER (IDFLT1=1024)
      PARAMETER (IDINT2=IDFLT1*256)
      PARAMETER (IDINT1=IDINT2*32)
      PARAMETER (MESA1=IDINT1*LNSUB+(12+LKDIM)*IDINT2+IDFLT1*LLOC1
     1  +LTXTAA)
      PARAMETER (MESA2=IDFLT1*LDELTA+LTXTAB)
      PARAMETER (MESA3=IDINT1*LPART+IDINT2*LKAIMT+IDFLT1*LEPS+LTXTAC)
      PARAMETER (MESA4=29*IDINT1+IDFLT1*LWORRY+LTXTAD)
      PARAMETER (MESA5=30*IDINT1+LTXTAE)
      PARAMETER (MESA6=(32+LK)*IDINT1+(12+LKDIM)*IDINT2+IDFLT1*LERRI+
     *   LTXTAG)
      PARAMETER (MESA7=32*IDINT1+LTXTAH)
      PARAMETER (MESA8=32*IDINT1+IDFLT1*LX+LTXTAM)
      PARAMETER (MESA9=IDINT1*(96+LNSUB)+IDFLT1*LDISCX+LTXTAA)
      PARAMETER (MESA10=64*IDINT1+IDFLT1*LRNDC+LTXTAN)
      PARAMETER (MESA11=64*IDINT1+IDFLT1*LLOC3+LTXTAO)
      PARAMETER (MESA12=IDINT1*(64+LWHERE)+IDINT2*LNSUB+IDFLT1*LDELMN+
     *   LTXTAP)
      PARAMETER (MESA13=31*IDINT1)
      PARAMETER (MESA14=32*IDINT1+IDFLT1*LDELTA+LTXTAQ)
      PARAMETER (MESA15=64*IDINT1+IDFLT1*LDISCX+LTXTAR)
C
      PARAMETER (MESL3=-(16*IDINT1+5*IDINT2+57))
      PARAMETER (MESL5=-(IDINT2*LISTOP+IDFLT1*LXJ+LTXTAI))
      PARAMETER (MESL6=-(8*IDINT1+IDINT2*LINC+IDFLT1*LTPS+LTXTAL))
      PARAMETER (MESL8=-(10*IDINT1+1*IDINT2+24))
      PARAMETER (MESL9=-(11*IDINT1+6*IDINT2+68))
      PARAMETER (MESL13=-(15*IDINT1+3*IDINT2+25))
C           JUMP = 1  2      3  4      5      6  7      8      9
      DATA MESSL / 1, 6, MESL3, 7, MESL5, MESL6, 9, MESL8, MESL9,
     *    12, 13, 14, MESL13 /
C  JUMP = 10  11  12      13

      DATA MESSA / MESA1, MESA2, MESA3, MESA4, MESA5, MESA6, MESA7,
     *   MESA8, MESA9, MESA10, MESA11, MESA12, MESA13, MESA14, MESA15 /

      DATA MACT / MENTXT, 0, MEFDAT, 0, METEXT,
     *            MENTXT, 0, MEFDAT, 0, METEXT,
     *            MENTXT, 0, MEFDAT, 0, METEXT,
     *            MENTXT, 0, MEFDAT, 0, METEXT,
     *            MENTXT, 0, MEFDAT, 0, METEXT, MERET/
      DATA MACTMA / MEFMAT, 17, 0, 4, LTXTAK, LTXTAJ, MERET /
      DATA MACTAR / METEXT, MEFDAT, 0, MEFVEC, 0, MERET /
      DATA MACTH / METEXT, MERET /
      DATA MACTER / MEEMES, 0, 0, -1, MECONT /
C
C     *****     EXECUTABLE STATEMENTS     ******************************
C
      IF (JUMP .EQ. 2) THEN
         IF (NEEDH) CALL MESS(MACTH, MTXTAB, IDAT)
         NEEDH = .FALSE.
      ELSE
         NEEDH = .TRUE.
      END IF
      LMACT = 2
      LIDAT = 1
      LMESS = MESSL(JUMP)
      IF (LMESS .LT. 0) THEN
C                         Output data from the unsaved common block
         MESSF = -LMESS
         GO TO 20
      END IF
   10 MESSF = MESSA(LMESS)
   20 II1 = MESSF / IDINT1
      MESSF = MESSF - II1 * IDINT1
      II2 = MESSF / IDINT2
      MESSF = MESSF - II2 * IDINT2
      IF1 = MESSF / IDFLT1
      MACT(LMACT) = MESSF - IF1 * IDFLT1
      MACT(LMACT+2) = IF1
      IF (LMESS .LE. 0) THEN
         LMESS = II1
         IF (IF1 .EQ. 0) THEN
            IF (LMESS .EQ. 0) RETURN
            MACTER(2) = MACT(LMACT)
            MACTER(3) = II2
            CALL MESS(MACTER, MTXTAG, IDAT)
            NDIM = NDIM + 100
            GO TO 10
         END IF
         MACT(6) = MECONT
         CALL SMESS(MACT, MTXTAA, INSAV(II2), FNSAV)
         MACT(6) = MENTXT
         IF (IF1 .NE. LXJ) GO TO 10
         CALL SMESS(MACTH, MTXTAC, ISAV(LSEARC), FSAV(LPHISU))
         MACTMA(3) = LENDT
         CALL SMESS(MACTMA, MTXTAA, IDAT, FSAV(LXT))
         RETURN
      ELSE
         IF (II1 .GE. 32) THEN
            LMESS = II1 / 32
            II1 = II1 - 32*LMESS
            LMESS = LMESS - 1
         ELSE
            LMESS = LMESS + 1
         END IF
         IF (II1 .NE. 0) THEN
            IF (II1 .GT. 12) THEN
               IF (II1 .GE. 28) THEN
                  GO TO (100, 110, 120), II1-28
                  LMESS = 1
                  GO TO 220
  100             IF (DISCHK .EQ. 0) GO TO 10
                     IDAT(LIDAT) = DISCHK
                     MACT(LMACT+2) = IF1 + PART - 1
                     GO TO 200
  110             LMESS = 1
                     IF (NSUB .NE. 0) LMESS = -1
                     IF (NDIM .EQ. 1) GO TO 220
                     IDAT(LIDAT) = KDIM
                     GO TO 200
C Take care of stuff that is double precision in single precision code.
  120             FDAT(1) = RESULT(I)
                     FDAT(2) = ACUM
                     FDAT(3) = ERR
                     FDAT(4) = EPSMIN
                     IDAT(1) = I
                     IDAT(2) = KDIM
                     CALL SMESS(MACTH, MTXTAD, IDAT, FDAT)
                     GO TO 230
               ELSE
                  IDAT(LIDAT) = INSAV(II1-12)
               END IF
            ELSE
               IDAT(LIDAT) = ISAV(II1)
            END IF
            IF (II2 .NE. 0) THEN
               LIDAT = LIDAT + 1
               IF (II2 .GT. 12) THEN
                  IDAT(LIDAT) = INSAV(II2-12)
               ELSE
                  IDAT(LIDAT) = ISAV(II2)
               END IF
            END IF
            LIDAT = LIDAT + 1
         END IF
      END IF
  200 LMACT = LMACT + 5
      IF (LMESS .GT. 1) GO TO 10
  220 MACT(LMACT-1) = MERET
      IF (NDIM .GT. 100) MACT(LMACT-1) = MECONT
      CALL SMESS(MACT, MTXTAA, IDAT, FSAV)
      MACT(LMACT-1) = MEFDAT
      IF (LMESS .EQ. 0) RETURN
      IF (LMESS .LT. 0) then
         ABSCIS = abs(LOCAL(4) - LOCAL(3))
         IDAT(1) = KDIM
         CALL SMESS(MACTH, MTXTAF, IDAT, FSAV(LLOC3))
      end if
  230 IF (NDIM .LE. KDIM) RETURN
      LMACT = 1
      IF (NDIM .GT. 100) THEN
         NDIM = NDIM - 100
         IF (NDIM .LE. KDIM) LMACT = 2
      END IF
      IDAT(2) = NDIM
      IDAT(1) = KDIM+1
      MACTAR(3) = IDAT(1)
      MACTAR(5) = -NDIM
      CALL SMESS(MACTAR(LMACT), MTXTAE, IDAT, WORK)
      RETURN
      END
