SUBROUTINE DINTDL (WORK)
c Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
c ALL RIGHTS RESERVED.
c Based on Government Sponsored Research NAS7-03001.
c>> 1996-04-27 DINTDL Krogh  Changes to use .C. and C%%.
C>> 1996-03-31 DINTDL Krogh  Removed unused variable in common.
c>> 1996-03-30 DINTDL Krogh  Change specific intrinsics to generics.
c>> 1995-11-28 DINTDL Krogh  Converted from SFTRAN to Fortran 77.
C>> 1994-11-14 DINTDL Krogh  Declared all vars.
C>> 1994-10-19 DINTDL Krogh  Changes to use M77CON
C>> 1994-08-22 DINTDL Krogh -- Modified data for C conversion.
c>> 1994-07-07 DINTDL Snyder set up for CHGTYP.
C>> 1994-05-24 DINTDL Krogh -- Fixes data and max's for C conversion.
C>> 1994-05-02 DINTDL Snyder Structured some spaghetti code
C>> 1993-05-18 DINTDL Krogh -- Changed "END" to "END PROGRAM"
C>> 1991-09-20 DINTDL Krogh converted '(1)' dimensioning to '(*)'.
C>> 1987-11-19 DINTDL Snyder  Initial code.
C
C     THIS SUBPROGRAM FORMS AND ANALYZES DIFFERENCE LINES FOR DINT
C
c--D replaces "?": ?INT, ?INTA, ?intc, ?intec, ?INTDL, ?INTNC, ?INTO
C
C     *****     FORMAL ARGUMENT   **************************************
C
C WORK    IS THE USER WORK ARRAY.  IT IS NOT USED HERE, BUT IS
C         PASSED INTO DINTO.
      DOUBLE PRECISION WORK(*)
C
C     *****    EXTERNAL REFERENCES   ***********************************
C
C DINTO   USED FOR PRINTING OUTPUT.
C
C     *****    INTERNAL AND COMMON VARIABLES   *************************
C
C ALOCAL  IS THE LEFT END OF THE CURRENT PANEL.
      DOUBLE PRECISION ALOCAL
C BETAS   ARE COEFFICIENTS USED TO COMPUTE DIFFERENCE LINES
      DOUBLE PRECISION BETAS (133)
C BLOCAL  IS THE RIGHT END OF THE CURRENT PANEL.
      DOUBLE PRECISION BLOCAL
C DTLENT  IS A TABLE OF INITIAL DIFFERENCE TABLE LENGTHS.
      INTEGER DTLENT(3)
C FATA    IS THE FUNCTION VALUE AT ALOCAL.
      DOUBLE PRECISION FATA
C FATAS   INDICATES WHEN FATA HAS USEFUL DATA.
      LOGICAL FATAS
C FATB    IS THE FUNCTION VALUE AT BLOCAL.
      DOUBLE PRECISION FATB
C FATBS   INDICATES WHEN FATB HAS USEFUL DATA.
      LOGICAL FATBS
C IB1     ARE STARTING VALUES FOR INDEXING THE BETAS TABLE
      INTEGER IB1(3)
C PHIT    IS THE BACKWARD DIFFERENCE LINE.  PHIT IS EQUIVALENCED
C         WITH PHI (BELOW).
      DOUBLE PRECISION PHIT(17)
C PMAX    IS THE MAXIMUM OF THREE ADJACENT VALUES OF PHI OR PHIT.  THIS
C         IS USED WHEN EXAMINING JUMPS TO AVOID OVERFLOWS.
      DOUBLE PRECISION PMAX
C XJUMPN  IS THE VALUE TO USE FOR XJUMP WHEN NOT DOING A SEARCH.
      DOUBLE PRECISION XJUMPN
C XJUMPS  IS THE VALUE TO USE FOR XJUMP WHEN DOING A SEARCH.
      DOUBLE PRECISION XJUMPS
C Z5      IS AN ADJUSTABLE PARAMETER USED DURING DEVELOPMENT.
      DOUBLE PRECISION Z5
      INTEGER INSTOP, IC2, IC1
C
C SEE DINTA FOR A DESCRIPTION OF REMAINING COMMON VARIABLES
C
C     *****    COMMON STORAGE ******************************************
C
C     COMMON /DINTNC/ CONTAINS VARIABLES NOT SEPARATELY SAVED FOR
C     EACH DIMENSION OF A MULTIPLE QUADRATURE.  COMMON /DINTC/
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 /DINTC/.  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 /DINTNC/ VARIABLES.
C
      DOUBLE PRECISION AINIT, BINIT, FNCVAL, S, TP
      DOUBLE PRECISION 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 /DINTC/ 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
      DOUBLE PRECISION
     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 DINTC.
C     30 $DSTYP$ VARIABLES
      DOUBLE PRECISION
     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 /DINTNC/
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 /DINTC/
     1 ACUM,   PACUM,  RESULT
      COMMON /DINTC/
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 /DINTC/
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 /DINTC/
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 /DINTC/
     1 DID1,   FAIL,   FATS,   FSAVED, HAVDIF, IEND,   INIT,   ROUNDF,
     2 XCDOBT, PAD
      SAVE /DINTNC/, /DINTC/
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.
      DOUBLE PRECISION
     1  EMEPS,  EEPSM8, EDELM2, EDELM3, ESQEPS, ERSQEP, ERSQE6, EMINF,
     2  ESMALL, ENZER,  EDELM1, ENINF
      COMMON /DINTEC/
     1  EMEPS,  EEPSM8, EDELM2, EDELM3, ESQEPS, ERSQEP, ERSQE6, EMINF,
     2  ESMALL, ENZER,  EDELM1, ENINF
      SAVE /DINTEC/
C
C     *****    EQUIVALENCE STATEMENTS    *******************************
C
      EQUIVALENCE (PHI(18),PHIT)
      EQUIVALENCE (FAT(1),FATA),(FAT(2),FATB)
      EQUIVALENCE (FATS(1),FATAS),(FATS(2),FATBS)
      EQUIVALENCE (LOCAL(1),ALOCAL),(LOCAL(2),BLOCAL)
      EQUIVALENCE (ISTOP(1,1),IC1),(ISTOP(1,2),IC2)
C
C     *****    DATA STATEMENTS   ***************************************
C
      DATA DTLENT /5,7,15/
      DATA IB1 /1,10,30/
      DATA XJUMPN /0.25D0/
      DATA XJUMPS /0.5D0/
      DATA Z5 /0.01D0/
C
C     BETAS( 1:  9) are for computing 5-point difference line.
C     BETAS(10: 29) are for computing 7-point difference line.
C     BETAS(30:133) are for computing 15-point difference line.
C
c++ Save data by elements if ~.C.
      DATA BETAS(1) /   .3436491673103708451D+001 /
      DATA BETAS(2) /   .2909944487358056275D+000 /
      DATA BETAS(3) /   .1000000000000000001D+001 /
      DATA BETAS(4) /   .1549193338482966760D+001 /
      DATA BETAS(5) /  -.1878361089654305178D+000 /
      DATA BETAS(6) /   .2909944487358056232D+000 /
      DATA BETAS(7) /   .1878361089654305149D+000 /
      DATA BETAS(8) /   .1878361089654305149D+000 /
      DATA BETAS(9) /   .1000000000000000015D+001 /
      DATA BETAS(10) /  .1830891918707665993D+001 /
      DATA BETAS(11) /  .5461818853326139665D+000 /
      DATA BETAS(12) /  .1275863152521727801D+001 /
      DATA BETAS(13) /  .1877974359956861711D+001 /
      DATA BETAS(14) / -.2908356455650225802D+000 /
      DATA BETAS(15) /  .1000000000000000003D+001 /
      DATA BETAS(16) /  .1121212539609889453D+001 /
      DATA BETAS(17) /  .1411118538882285126D+001 /
      DATA BETAS(18) /  .2061029159147656548D+000 /
      DATA BETAS(19) /  .7837831181373271228D+000 /
      DATA BETAS(20) /  .6990495472071992051D+000 /
      DATA BETAS(21) /  .6990495472071992051D+000 /
      DATA BETAS(22) /  .7764649827988754109D+000 /
      DATA BETAS(23) / -.2654374897523893370D+000 /
      DATA BETAS(24) /  .5461818853326139587D+000 /
      DATA BETAS(25) /  .3710664836162815639D+000 /
      DATA BETAS(26) /  .2948330583120690783D+000 /
      DATA BETAS(27) /  .2654374897523893283D+000 /
      DATA BETAS(28) /  .2654374897523893275D+000 /
      DATA BETAS(29) /  .1000000000000000036D+001 /
      DATA BETAS(30) /  .2160483964289764787D+001 /
      DATA BETAS(31) /  .4628592558560086054D+000 /
      DATA BETAS(32) /  .1580721165376834188D+001 /
      DATA BETAS(33) /  .2788648704047761366D+001 /
      DATA BETAS(34) / -.1659797647456139336D+000 /
      DATA BETAS(35) /  .1348061361080862260D+001 /
      DATA BETAS(36) /  .1938801234758797259D+001 /
      DATA BETAS(37) /  .3001371201600030120D+001 /
      DATA BETAS(38) /  .5530131183278168619D-001 /
      DATA BETAS(39) /  .1217373546890437278D+001 /
      DATA BETAS(40) /  .1549754626219785878D+001 /
      DATA BETAS(41) /  .2074091833232865716D+001 /
      DATA BETAS(42) /  .2928362520543975785D+001 /
      DATA BETAS(43) / -.1888472190338949389D-001 /
      DATA BETAS(44) /  .1128427531866524394D+001 /
      DATA BETAS(45) /  .1318613567768740554D+001 /
      DATA BETAS(46) /  .1600194155392385446D+001 /
      DATA BETAS(47) /  .2022328205978644955D+001 /
      DATA BETAS(48) /  .2663864875210043425D+001 /
      DATA BETAS(49) /  .7089219156396005268D-002 /
      DATA BETAS(50) /  .1059422356252840359D+001 /
      DATA BETAS(51) /  .1156722975732715836D+001 /
      DATA BETAS(52) /  .1303394479759645425D+001 /
      DATA BETAS(53) /  .1518037435357655518D+001 /
      DATA BETAS(54) /  .1829746290708357198D+001 /
      DATA BETAS(55) /  .2281090415029519236D+001 /
      DATA BETAS(56) / -.3107820325615749339D-002 /
      DATA BETAS(57) /  .1000000000000000007D+001 /
      DATA BETAS(58) /  .1028853894914960778D+001 /
      DATA BETAS(59) /  .1089361496056109992D+001 /
      DATA BETAS(60) /  .1187656139924609753D+001 /
      DATA BETAS(61) /  .1334063529367354927D+001 /
      DATA BETAS(62) /  .1544285866555422247D+001 /
      DATA BETAS(63) /  .1839592669101145570D+001 /
      DATA BETAS(64) /  .1689406778911703374D-002 /
      DATA BETAS(65) /  .9439106076041133657D+000 /
      DATA BETAS(66) /  .9174389213758399244D+000 /
      DATA BETAS(67) /  .9174389213758399244D+000 /
      DATA BETAS(68) /  .9435097871391599084D+000 /
      DATA BETAS(69) /  .9977420273821314863D+000 /
      DATA BETAS(70) /  .1084782404725432559D+001 /
      DATA BETAS(71) /  .1211987194763725285D+001 /
      DATA BETAS(72) /  .1388740619829111076D+001 /
      DATA BETAS(73) / -.1216502747013758565D-002 /
      DATA BETAS(74) /  .8861889414785074481D+000 /
      DATA BETAS(75) /  .8116449626771402972D+000 /
      DATA BETAS(76) /  .7665628757411781400D+000 /
      DATA BETAS(77) /  .7453813701489683382D+000 /
      DATA BETAS(78) /  .7453813701489683365D+000 /
      DATA BETAS(79) /  .7659548081345759537D+000 /
      DATA BETAS(80) /  .8082259176409903757D+000 /
      DATA BETAS(81) /  .8747663621098320137D+000 /
      DATA BETAS(82) /  .9688039688731088254D+000 /
      DATA BETAS(83) /  .1255674817712366966D-002 /
      DATA BETAS(84) /  .8214405533571194637D+000 /
      DATA BETAS(85) /  .7029626866105575496D+000 /
      DATA BETAS(86) /  .6238580132970762736D+000 /
      DATA BETAS(87) /  .5722253065058340695D+000 /
      DATA BETAS(88) /  .5411220158316336791D+000 /
      DATA BETAS(89) /  .5265875548985245415D+000 /
      DATA BETAS(90) /  .5265875548985245415D+000 /
      DATA BETAS(91) /  .5404122752915469377D+000 /
      DATA BETAS(92) /  .5682467824057592445D+000 /
      DATA BETAS(93) /  .6105250012592685202D+000 /
      DATA BETAS(94) / -.2056713181478912089D-002 /
      DATA BETAS(95) /  .7418059955358485150D+000 /
      DATA BETAS(96) /  .5827083724168839593D+000 /
      DATA BETAS(97) /  .4801712113071248704D+000 /
      DATA BETAS(98) /  .4122773863015805726D+000 /
      DATA BETAS(99) /  .3670318230087162626D+000 /
      DATA BETAS(100) / .3375820566477249038D+000 /
      DATA BETAS(101) / .3199261416708740619D+000 /
      DATA BETAS(102) / .3117418541236820569D+000 /
      DATA BETAS(103) / .3117418541236820569D+000 /
      DATA BETAS(104) / .3192575114045456230D+000 /
      DATA BETAS(105) / .3337942651525015294D+000 /
      DATA BETAS(106) / .6161619285278180942D-002 /
      DATA BETAS(107) / .6326226420594590703D+000 /
      DATA BETAS(108) / .4398667200206020996D+000 /
      DATA BETAS(109) / .3286669728647044621D+000 /
      DATA BETAS(110) / .2600621241862664580D+000 /
      DATA BETAS(111) / .2157588962131737290D+000 /
      DATA BETAS(112) / .1863878189966076094D+000 /
      DATA BETAS(113) / .1668253817995868195D+000 /
      DATA BETAS(114) / .1541355533671636686D+000 /
      DATA BETAS(115) / .1465855112207078905D+000 /
      DATA BETAS(116) / .1431347342606662998D+000 /
      DATA BETAS(117) / .1431347342606662993D+000 /
      DATA BETAS(118) / .1460769330400709832D+000 /
      DATA BETAS(119) /  -.4218064520555042749D-001 /
      DATA BETAS(120) / .4628592558560086436D+000 /
      DATA BETAS(121) / .2623677271576596603D+000 /
      DATA BETAS(122) / .1694821597218475388D+000 /
      DATA BETAS(123) / .1200403163514239665D+000 /
      DATA BETAS(124) / .9113109297367898293D-001 /
      DATA BETAS(125) / .7309959229942654766D-001 /
      DATA BETAS(126) / .6136503430084129995D-001 /
      DATA BETAS(127) / .5355473492811662567D-001 /
      DATA BETAS(128) / .4835640867710043200D-001 /
      DATA BETAS(129) / .4500777786787335424D-001 /
      DATA BETAS(130) / .4304768732135345497D-001 /
      DATA BETAS(131) / .4218064520555042532D-001 /
      DATA BETAS(132) / .4218064520555042532D-001 /
      DATA BETAS(133) / .1000000000000000051D+001 /
C
C     *****    PROCEDURES     ******************************************
C
      IF (WHERE.EQ.0) THEN
C
C     PREPARE TO COMPUTE THE DIFFERENCES.
C
         HAVDIF=.TRUE.
         XJUMP=XJUMPN
         IF (ABS(WORRY(PART)-START(PART)).LT.ABS(BLOCAL-START(PART))
     1   .OR.DISCHK.GT.0) XJUMP=XJUMPS
C        PACK THE ABSCISSA AND FUNCTION TABLES.
         KK=min(K,4)
C        KK MUST BE RECOMPUTED BECAUSE IT IS NOT SAVED IN EACH DIMENSION
         LENDT=DTLENT(KK-1)
         J1=L
         IF (K.EQ.2) J1=0
         DO 10 J=1,LENDT
            XT(J)=XT(J1+1)
            FT(J)=FT(J1+1)
            J1=J1+L
10       CONTINUE
C
C     COMPUTE MODIFIED DIVIDED DIFFERENCES.
C
         PHIT(LENDT)=FT(LENDT)
         PHI(1)=FT(1)
         PHIT(1)=FT(2)-FT(1)
         PHI(2)=-PHIT(1)
         L=IB1(KK-1)
         DO 40 I=3,LENDT
            PHIT(I-1)=FT(I)-FT(I-1)
            DO 20 J=3,I
               PHIT(I-J+1)=PHIT(I-J+2)-BETAS(L)*PHIT(I-J+1)
               L=L+1
20          CONTINUE
            PHI(I)=PHIT(1)*BETAS(L)
            L=L+1
40       CONTINUE
         NFJUMP=NFEVAL
C
C     COMPUTE THE SUMS OF THE ABSOLUTE VALUES OF THE MIDDLE DIFFERENCES.
C
         L=(LENDT+1)/2
         PHISUM=ABS(PHI(L))
         PHTSUM=ABS(PHIT(L))
         IF (K.GE.3) THEN
            PHISUM=ABS(PHI(L-1))+PHISUM+ABS(PHI(L+1))
            PHTSUM=ABS(PHIT(L-1))+PHTSUM+ABS(PHIT(L+1))
         END IF
C
C     IF THE CURRENT PANEL CONTAINS THE END OF A PART,
C     WE ARE NOT USING A T**N TRANSFORMATION AND PHISUM IS LESS THAN
C     PHTSUM, TURN THE PROBLEM AROUND AND INTEGRATE IN THE OPPOSITE
C     DIRECTION.
C
         IF (IEND) THEN
            IF (NSUB.EQ.0) THEN
               IF (PHISUM.LT.PHTSUM) THEN
C                 REVERSE DIRECTION OF INTEGRATION STEP ACCUMULATION.
                  IF (WORRY(PART).EQ.BLOCAL) WORRY(PART)=ALOCAL
                  START(PART)=BLOCAL
                  END(PART)=ALOCAL
                  ALOCAL=BLOCAL
                  BLOCAL=END(PART)
                  LOCAL(3)=ALOCAL
                  LOCAL(4)=BLOCAL
                  TEND=BLOCAL
                  TA=START(PART)
                  TB=BLOCAL-TA
                  X1=XJ
                  XJ=XJP
                  XJP=X1
                  J1=L-1
                  DO 60 I=1,J1
                     FUNCT(I+17)=FUNCT(I+1)-FUNCT(I+17)
                     S=XT(L-I)
                     XT(L-I)=XT(L+I)
                     XT(L+I)=S
                     S=FT(L-I)
                     FT(L-I)=FT(L+I)
                     FT(L+I)=S
                     S=PHI(L-I)
                     PHI(L-I)=PHIT(L+I)
                     PHIT(L+I)=S
                     S=PHIT(L-I)
                     PHIT(L-I)=PHI(L+I)
                     PHI(L+I)=S
60                CONTINUE
                  S=PHI(L)
                  PHI(L)=PHIT(L)
                  PHIT(L)=S
                  DIFF=-DIFF
                  STEP(PART)=-STEP(PART)
                  S=FATA
                  FATA=FATB
                  FATB=S
                  FSAVED=FATAS
                  FATAS=FATBS
                  FATBS=FSAVED
                  FSAVED=.FALSE.
C     IF WE ARE TURNING AROUND THE END OF PART 2, HAVE NOT YET DONE
C     ANYTHING IN PART 2 AND HAVE NO DISCONTINUITY DIAGNOSTIC
C     PENDING, UNDO THE SUBDIVISION AND RETURN TO MARCHING.
                  IF (PART.EQ.2) THEN
                     IF (DISCF.EQ.0) THEN
                        IF (START(1).EQ.BLOCAL) THEN
                           START(1)=START(2)
                           PART=1
                           IEND=.FALSE.
                        END IF
                     END IF
                  END IF
                  IF (IPRINT.GT.3) CALL DINTO (4,WORK)
               END IF
            END IF
         END IF
      END IF
C
C     EXAMINE THE DIFFERENCE LINES.
C
      I=2
      J=2
      KK=1
      INC=1
      INC2=2
      INSTOP=LENDT
      J2=0
      IF (.NOT.DID1) J2=NSUB+4
      S=100.0d0*EPSMIN/DELTA
      IF (SEARCH.EQ.4) S=0.0d0
C     do forever
80    continue
         L=I
         ISTOP(1,KK)=L
         TP=ABS(PHI(J-INC))+Z5*S
         XJ=XJUMP
         J1=0
C        While
90       if (I.ne.INSTOP) then
            I=I+INC
            TP=TP+ABS(PHI(J))
            J=J+INC
            IF (ABS(PHI(J-INC))+2.0d0*ABS(PHI(J))
     1      .lt.S+ABS(PHI(J-INC2))) then
               L=I+(L+INC2-I)/2
               IF (L.EQ.I) GO TO 80
               if (i .le. j2) GO TO 80
            else
               IF (SIGN(1.0d0,PHI(J))*PHI(J-INC).GE.0.0d0) GO TO 120
            end if
            IF (SEARCH.NE.4) XJ=XJ+XJ
120         continue
            IF (ABS(PHI(J)*XJ).LE.TP) GO TO 90
            XJ=MAX(4.0d-4,TP/ABS(PHI(J)))
            J1=I
            GO TO 90
         end if
C        end while
         IF (ABS(XJ).GE.XJUMP) J1=0
         ISTOP(2,KK)=J1
         IF (INC.lt.0) GO TO 140
         J2=0
         XJP=XJ
         INSTOP=1
         INC2=-2
         INC=-1
         I=I+INC
         J=16+LENDT
         KK=2
         GO TO 80
C     end forever
140   continue
C     WEAKEN JUMPS IF A LOT OF CONVERGENCE OVERLAP WITH JUMP, THEN TEST
C     IF JUMP CAN BE IGNORED.
      J1=ISTOP(2,1)
      J2=ISTOP(2,2)
C     do block
         IF (J1.ne.0) then
            I=J1-IC2-1
            IF (I.gt.0) then
               XJP=XJP*6.0d0**I
               IF (XJP.GE.1.0d0) GO TO 160
            end if
            S=1.0D-4
            IF (J1.NE.LENDT) S=0.1d0**MAX(J1-J2+1,1)
            PMAX=MAX(ABS(PHI(J1-2)),MAX(ABS(PHI(J1-1)),ABS(PHI(J1))))
      IF (ABS(S*(PHI(J1)/PMAX)*PHI(J1-2)).GE.(PHI(J1-1)/PMAX)*PHI(J1-1))
     1          XJP=-XJP
            IF (J1.LT.LENDT) GO TO 170
            IF (ABS(XJP).LT.1.0D-3) GO TO 170
            IF (IC1.NE.2) GO TO 170
         end if
160      continue
         ISTOP(2,1)=18
         XJP=ABS(XJP)
C     end block
170   continue
C     do block
         IF (J2.ne.0) then
            I=IC1-J2-1
            IF (I.gt.0) then
               XJ=XJ*6.0d0**I
               IF (XJ.GE.1.0d0) GO TO 190
            end if
            S=1.0D-4
            IF (J2.NE.1) S=0.1d0**MAX(J1-J2+1,1)
            PMAX=MAX(ABS(PHIT(J2)),MAX(ABS(PHIT(J2+1)),ABS(PHIT(J2+2))))
            IF(ABS(S*(PHIT(J2)/PMAX)*PHIT(J2+2))
     1         .GE.(PHIT(J2+1)/PMAX)*PHIT(J2+1)) XJ=-XJ
            IF (J2.GE.2) GO TO 200
            IF (ABS(XJ).LT.1.0D-3) GO TO 200
            IF (IC2.NE.LENDT-1) GO TO 200
190         ISTOP(2,2)=0
         end if
         XJ=ABS(XJ)
C     end block
200   continue
      IF (J2.EQ.1) THEN
         IF (ABS(PHIT(2)).GT.100.0d0*ABS(PHIT(3))) XJ=ABS(XJ)
      END IF
      IF (J1.EQ.LENDT) THEN
         IF(ABS(PHI(LENDT-1)).GT.100.0d0*ABS(PHI(LENDT-2))) XJP=ABS(XJP)
      END IF
      IF (IPRINT.GT.3) CALL DINTO (5,WORK)
      RETURN
      END

.