Possibility to have different binaries in the same tree introduced

[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / exmbuc.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:03:24  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      INTEGER FUNCTION EXMBUC(NUMBER, NDIM, BUCKTS, GOOD, MAXFUN, MAXDPH
     1, IRM)
      INTEGER NUMBER, NDIM, MAXFUN, MAXDPH
      REAL GOOD, BUCKTS(IRM)
      COMMON /PRINT/ IPRINT
      INTEGER IPRINT
      COMMON /ANSWER/ INTGRL,ERROR,ERRMAX,GEFF,Q2,Q3,Q5,NUMBR,MBUC
      COMMON /DEPTHS/ FSTDPH,INCDPH
      INTEGER FSTDPH,INCDPH,NTREES
      REAL INTGRL,VAR,ERROR,ERRMAX,VARMAX,VARMX2,PRCNT
      REAL Q2,Q3,Q5,GEFF,SEFF,FMAX,FMIN,TOTVOL
      COMMON /QUADRE/ DEGREE
      INTEGER DEGREE
      COMMON /MAXERR/ ERRPCT,ERRABS
      REAL ERRPCT,ERRABS
      COMMON /FUNN/ NFUN, NFOPT, NFCUT
      INTEGER NFUN, NFOPT, NFCUT
      COMMON /SIGSPL/ COORD,PLACE,FSTENT,DOSPLT
      COMMON /BUKSZE/ MAXWRD
      INTEGER MAXWRD
      COMMON /LIMITS/ GMINUS(10),GPLUS(10)
      LOGICAL FSTENT,DOSPLT,UTERM,USRTRM
      REAL COORD,PLACE
      INTEGER NUMBR,PTR
      NUMBR=NUMBER
      IF(NUMBER.NE.1) GOTO 40
      NTREES=0
      ERRPCT=GOOD
      ERRABS=0
      MAXDPH=FSTDPH
      FSTENT=.TRUE.
      NFUN=0
      NFOPT=0
      NFCUT=0
      DOSPLT=.FALSE.
      GUUD=ABS(GOOD)
      IF(GOOD.GE.0) GOTO 10
      ERRABS=GUUD
      ERRPCT=0
 10   IF(DEGREE.NE.1.AND.DEGREE.NE.2.AND.DEGREE.NE.3.AND.DEGREE.NE.5) 
     1 DEGREE=0
      IF(DEGREE.NE.1) GOTO 30
      TOTVOL=1.0E+0
      DO 20 I=1,NDIM
      TOTVOL=TOTVOL*(GPLUS(I)-GMINUS(I))
 20   CONTINUE
 30   EXMBUC=0
      RETURN
 40   NTREES=NTREES+1
      MBUC=0
      PTR=MBUC
      INTGRL=0.0E+0
      VAR=INTGRL
      VARMAX=VAR
      VARMX2=VARMAX
      Q2=VARMX2
      Q3=Q2
      Q5=Q3
      GEFF=Q5
      FMAX=GEFF
      FMIN=FMAX
      DO 80 IBUC=1,NUMBER
      INTGRL=INTGRL+BUCKTS(PTR+1)
      VAR=VAR+BUCKTS(PTR+2)
      IF(BUCKTS(PTR+2).LE.VARMAX) GOTO 50
      VARMX2=VARMAX
      VARMAX=BUCKTS(PTR+2)
      MBUC=IBUC
      GOTO 60
 50   IF(BUCKTS(PTR+2).LE.VARMX2) GOTO 60
      VARMX2=BUCKTS(PTR+2)
 60   IF(DEGREE.NE.1) GOTO 70
      GEFF=GEFF+(BUCKTS(PTR+5)-BUCKTS(PTR+6))*BUCKTS(PTR+7)
      FMAX=MAX(FMAX,BUCKTS(PTR+5))
      FMIN=MIN(FMIN,BUCKTS(PTR+6))
 70   IF(DEGREE.GE.2) Q2=Q2+BUCKTS(PTR+5)
      IF(DEGREE.GE.3) Q3=Q3+BUCKTS(PTR+6)
      IF(DEGREE.EQ.5) Q5=Q5+BUCKTS(PTR+7)
      PTR=PTR+MAXWRD
 80   CONTINUE
      ERROR=SQRT(VAR)
      ERRMAX=SQRT(VARMAX)
      IF(DEGREE.EQ.1) GEFF=INTGRL/GEFF
      IF(GOOD.LE.0) GOTO 100
      IF(INTGRL.EQ.0.0E+0) GOTO 90
      PRCNT=ERROR/ABS(INTGRL)
      GOTO 110
 90   PRCNT=0.0E+0
      GOTO 110
 100  PRCNT=ERROR
 110  UTERM=USRTRM(NTREES)
      IF(IPRINT.LE.0) GOTO 220
      IF(MOD(NTREES,IPRINT).NE.0 .AND. NFUN.LT.MAXFUN .AND. PRCNT.GT
     1.GUUD .AND. .NOT.UTERM) GOTO 220
      WRITE(6,120) NTREES,NUMBER,INTGRL,ERROR,ERRMAX,MBUC
 120  FORMAT(///' ITERATION ',I5,'.',I10,' REGIONS'/
     1 ' APPROXIMATE INTEGRAL = ',G13.5,'  WITH TOTAL RSS SPREAD ',
     2 G13.5/' THE LARGEST SINGLE SPREAD IS ',G13.5,
     3 '  IN REGION ',I5)
      IF(DEGREE.NE.1) GOTO 140
      SEFF=INTGRL/((FMAX-FMIN)*TOTVOL)
      WRITE(6,130) GEFF,SEFF
  130 FORMAT(' ESTIMATED RANGEN EFFICIENCY =',G13.5/
     *' SIMPLE ACCEPT/REJECT =',G13.5)
 140  IF(DEGREE.LT.2) GOTO 160
      WRITE(6,150) Q2
 150  FORMAT(' 2ND DEGREE QUADRATURE =  ',G13.5)
 160  IF(DEGREE.LT.3) GOTO 180
      WRITE(6,170) Q3
 170  FORMAT(' 3RD DEGREE QUADRATURE =  ',G13.5)
 180  IF(DEGREE.NE.5) GOTO 200
      WRITE(6,190) Q5
 190  FORMAT(' 5TH DEGREE QUADRATURE =  ',G13.5)
 200  WRITE(6,210) NFUN,NFOPT,NFCUT
 210  FORMAT(1X,I10,' INTEGRAND EVALUATIONS SO FAR'/1X,I10,
     1 ' IN OPTIMIZATION, ',I10,' IN FINDING CUTS')
 220  IF(NFUN.LT.MAXFUN) GOTO 250
      IF(IPRINT.LE.0) GOTO 240
      WRITE(6,230) MAXFUN
 230  FORMAT(' THIS EXCEEDES SPECIFIED LIMIT OF',I10)
 240  EXMBUC=0
      RETURN
 250  IF(PRCNT.GT.GUUD) GOTO 280
      IF(IPRINT.LE.0) GOTO 270
      WRITE(6,260) ERROR
 260  FORMAT(' TOTAL RSS SPREAD ',G13.5,' IS BELOW SPECIFIED MAXIMUM')
 270  EXMBUC=0
      RETURN
 280  IF(.NOT.(UTERM)) GOTO 310
      IF(IPRINT.LE.0) GOTO 300
      WRITE(6,290)
 290  FORMAT(' USER REQUESTED TERMINATION')
 300  EXMBUC=0
      RETURN
 310  EXMBUC=MBUC
      MAXDPH=INCDPH
      ERRABS=SQRT(VARMX2)
      DOSPLT=.TRUE.
      PTR=MAXWRD*(MBUC-1)
      COORD=BUCKTS(PTR+3)
      PLACE=BUCKTS(PTR+4)
      RETURN
      END