*
* $Id: split.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
*
* $Log: split.F,v $
* Revision 1.1.1.1  1996/04/01 15:03:24  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE SPLIT (NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,DISCRM,PART
     1N,BUCKTS,IRBUC)
      INTEGER NDIM, DISCRM, IRBUC
      LOGICAL TERMNL
      REAL FLOBD, FUPBD, PARTN
      REAL UMINUS(NDIM), UPLUS(NDIM), BUCKTS(IRBUC)
      INTEGER MPOINT
      COMMON /SAMPLE/ MPOINT
      INTEGER MAXWRD
      COMMON /BUKSZE/ MAXWRD
      REAL ERRPCT, ERRABS
      COMMON /MAXERR/ ERRPCT, ERRABS
      INTEGER NFUN, NFOPT, NFCUT
      COMMON /FUNN/ NFUN, NFOPT, NFCUT
      LOGICAL FSTENT, DOSPLT
      REAL COORD, PLACE
      COMMON /SIGSPL/ COORD, PLACE, FSTENT, DOSPLT
      INTEGER DEGREE
      COMMON /QUADRE/ DEGREE
      INTEGER MXRGNS, ISTOR
      COMMON /ISTRGE/ MXRGNS, ISTOR(12000)
      INTEGER RSTSZE
      REAL RSTOR
      COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
      REAL BNDTOL, FRACT, REGNTL, FNLTOL
      COMMON /CUTOLS/ BNDTOL, FRACT, REGNTL, FNLTOL
      INTEGER MAJOR, MINOR
      INTEGER ICUT(20), IWORK(20)
      INTEGER DCMSVE(20)
      INTEGER MAXJ, MINJ, NPOINT, NFCNT
      INTEGER DISCNT
      INTEGER NCUT
      EXTERNAL FUN
      LOGICAL LMAX
      REAL DIFEXT
      REAL X(10, 202), Y(202)
      REAL PARSVE(20)
C*NS  REAL DEVMAX, DEVMIN, YMAX, YMIN, SUM, CELVOL, YBAR, ERROR, ERRSQ
C*NS  DOUBLE PRECISION DPARTN, DFLOAT, DBNDTL, DFRACT, DREGTL, DFNLTL
      REAL         DEVMIN, YMAX, YMIN,      CELVOL, YBAR, ERROR, ERRSQ
      DOUBLE PRECISION DPARTN,         DBNDTL, DFRACT, DREGTL, DFNLTL
      DOUBLE PRECISION FMAJOR, FMINOR, VOL
      DOUBLE PRECISION DELPLS(10), DELNEG(10)
      DOUBLE PRECISION XLOW(10), XUP(10)
      DOUBLE PRECISION Z(10), WORK(200)
      DATA DISCNT /0/
      DATA NCUT /0/
      IF(.NOT.(DOSPLT)) GOTO 10
      DOSPLT=.FALSE.
      FSTENT=DOSPLT
      DISCRM=COORD
      PARTN=PLACE
      RETURN
 10   IF(NCUT.EQ.0) GOTO 20
      DISCRM=DCMSVE(NCUT)
      PARTN=PARSVE(NCUT)
      NCUT=NCUT-1
      DOSPLT=.FALSE.
      FSTENT=DOSPLT
      TERMNL=FSTENT
      RETURN
 20   ISCR=MXRGNS*(MAXWRD+1)+1
      NPOINT=MPOINT
      CALL QUASI(X,NDIM,NPOINT,MPOINT)
      DO 40 J=1,NPOINT
      DO 30 I=1,NDIM
      X(I,J)=(UPLUS(I)-UMINUS(I))*X(I,J)+UMINUS(I)
 30   CONTINUE
      Y(J)=FUN(NDIM,X(1,J))
 40   CONTINUE
      NFUN=NFUN+NPOINT
      CELVOL=1.0E+0
      DO 50 I=1,NDIM
      CELVOL=CELVOL*(UPLUS(I)-UMINUS(I))
 50   CONTINUE
#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
      YMAX=-9.9E+60
      YMIN=9.9E+60
#endif
#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
      YMAX= -9.9E34
      YMIN=  9.9E34
#endif
      DO 70 J=1,NPOINT
      IF(Y(J).GE.YMIN) GOTO 60
      YMIN=Y(J)
      MINJ=J
 60   IF(Y(J).LE.YMAX) GOTO 70
      YMAX=Y(J)
      MAXJ=J
 70   CONTINUE
      DO 80 I=1,NDIM
      X(I,NPOINT+1)=X(I,MAXJ)
      X(I,NPOINT+2)=X(I,MINJ)
 80   CONTINUE
      Y(NPOINT+1)=YMAX
      Y(NPOINT+2)=YMIN
      CALL BUFOPT(NDIM,X(1,NPOINT+2),X(1,NPOINT+1),UMINUS,UPLUS,Y(NPOIN
     1T+2),Y(NPOINT+1),FLOBD,FUPBD,WORK,200,IWORK,20,NFCNT,IRESLT)
      NFUN=NFUN+NFCNT
      NFOPT=NFOPT+NFCNT
      DIFEXT=Y(NPOINT+1)-Y(NPOINT+2)
      ERROR=DIFEXT*CELVOL*0.5E+0
      YBAR=0.0E+0
      DO 90 I=1,NPOINT
      YBAR=YBAR+Y(I)
 90   CONTINUE
      YBAR=YBAR/NPOINT
      FBAR=YBAR*CELVOL
      IF(ABS(Y(NPOINT+2)-YBAR).LE.ABS(Y(NPOINT+1)-YBAR)) GOTO 100
      MAJOR=NPOINT+2
      MINOR=NPOINT+1
      GOTO 110
 100  MAJOR=NPOINT+1
      MINOR=NPOINT+2
 110  FMAJOR=Y(MAJOR)
      FMINOR=Y(MINOR)
      I=1
      GOTO 130
 120  I=I+1
 130  IF((I).GT.(NDIM)) GOTO 140
      Z(I)=X(I,MAJOR)
      GOTO 120
 140  I=1
      GOTO 160
 150  I=I+1
 160  IF((I).GT.(NDIM)) GOTO 170
      XLOW(I)=UMINUS(I)
      XUP(I)=UPLUS(I)
      GOTO 150
 170  NCDIM=2*NDIM
      DFRACT=FRACT
      DBNDTL=BNDTOL
      CALL TSTEXT(NDIM,Z,XLOW,XUP,DBNDTL,DFRACT,NCUT,NCDIM,ICUT,DELPLS,
     1DELNEG)
      IF(NCUT.NE.0) GOTO 180
      CALL NOCUT(NDIM,XLOW,XUP,WORK(1),DISCNT,DISCRM,DPARTN,NFUN)
      PARTN=DPARTN
      GOTO 240
 180  LMAX=.TRUE.
      IF(FMAJOR.GE.FMINOR) GOTO 190
      LMAX=.FALSE.
 190  VOL=CELVOL
      DREGTL=REGNTL
      DFNLTL=FNLTOL
      CALL DELSLV(NDIM,FMAJOR,FMINOR,LMAX,DFRACT,Z,XLOW,XUP,VOL,NCUT,NCD
     1IM,ICUT,DELPLS,DELNEG,DREGTL,DFNLTL,WORK(1),WORK(NCDIM+1),WORK(2*N
     2CDIM+1),WORK(3*NCDIM+1),WORK(4*NCDIM+1),WORK(5*NCDIM+1),WORK(6*NCD
     3IM+1),WORK(7*NCDIM+1),WORK(8*NCDIM+1),NFCNT)
      NFUN=NFUN+NFCNT
      NFCUT=NFCUT+NFCNT
      IF(NCUT.NE.0) GOTO 200
      CALL NOCUT(NDIM,XLOW,XUP,WORK(1),DISCNT,DISCRM,DPARTN,NFUN)
      PARTN=DPARTN
      GOTO 240
 200  I=1
      GOTO 220
 210  I=I+1
 220  IF((I).GT.(NCUT)) GOTO 240
      DCMSVE(I)=ICUT(I)
      II=ABS(ICUT(I))
      IF(ICUT(I).LE.0) GOTO 230
      PARSVE(I)=X(II,MAJOR)+DELPLS(II)
      GOTO 210
 230  PARSVE(I)=X(II,MAJOR)-DELNEG(II)
      GOTO 210
 240  NCUTSV=NCUT
      IF(NCUT.LE.0) GOTO 250
      DISCRM=ICUT(NCUT)
      PARTN=PARSVE(NCUT)
      NCUT=NCUT-1
 250  IF(.NOT.(FSTENT)) GOTO 260
      FSTENT=.FALSE.
      TERMNL=FSTENT
      RETURN
 260  IF(ERROR.EQ.0.0E+0) GOTO 270
      TERMNL=TERMNL.OR.ERROR.LT.ERRABS
      IF(FBAR.NE.0.0E+0) TERMNL=TERMNL.OR.ERROR/ABS(FBAR).LE.ERRPCT
 270  IF(.NOT.(TERMNL)) GOTO 330
      NCUT=0
      IF(NCUTSV.LE.0) GOTO 290
#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
      DEVMIN=9.9E60
#endif
#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
      DEVMIN= 9.9E34
#endif
      DO 280 I=1,NCUTSV
      J=ABS(ICUT(I))
      XX=ABS(X(J,MAJOR)-PARSVE(I))
      IF(XX.GE.DEVMIN) GOTO 280
      DEVMIN=XX
      PARTN=PARSVE(I)
      DISCRM=ICUT(I)
 280  CONTINUE
 290  ERRSQ=ERROR**2
      ERRABS=MAX(ERRABS,ERROR)
      BUCKTS(1)=FBAR
      BUCKTS(2)=ERRSQ
      BUCKTS(3)=DISCRM
      BUCKTS(4)=PARTN
      IF(DEGREE.NE.1) GOTO 300
      BUCKTS(5)=Y(NPOINT+1)
      BUCKTS(6)=Y(NPOINT+2)
      BUCKTS(7)=CELVOL
 300  IF(DEGREE.LT.2) GOTO 310
      NFUN=NFUN+NDIM+1
      BUCKTS(5)=QUAD(NDIM,2,UMINUS,UPLUS,FUN)*CELVOL
 310  IF(DEGREE.LT.3) GOTO 320
      NFUN=NFUN+NDIM+NDIM
      BUCKTS(6)=QUAD(NDIM,3,UMINUS,UPLUS,FUN)*CELVOL
 320  IF(DEGREE.NE.5) GOTO 330
      NFUN=NFUN+2*NDIM**2+1
      BUCKTS(7)=QUAD(NDIM,5,UMINUS,UPLUS,FUN)*CELVOL
 330  RETURN
      END