mnbins.f

Go to the documentation of this file.

*
* $Id: mnbins.F,v 1.1.1.1 1996/03/07 14:31:28 mclareni Exp $
*
* $Log: mnbins.F,v $
* Revision 1.1.1.1  1996/03/07 14:31:28  mclareni
* Minuit
*
*
      SUBROUTINE mnbins(A1,A2,NAA,BL,BH,NB,BWID)
*
* $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506dp.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506dp.inc
*
C ************ DOUBLE PRECISION VERSION *************
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
C         SUBROUTINE TO DETERMINE REASONABLE HISTOGRAM INTERVALS
C         GIVEN ABSOLUTE UPPER AND LOWER BOUNDS  A1 AND A2
C         AND DESIRED MAXIMUM NUMBER OF BINS NAA
C         PROGRAM MAKES REASONABLE BINNING FROM BL TO BH OF WIDTH BWID
C         F. JAMES,   AUGUST, 1974 , stolen for Minuit, 1988
      parameter(zero=0.0, one=1.0)
      al = min(a1,a2)
      ah = max(a1,a2)
      IF (al.EQ.ah)  ah = al + 1.
C         IF NAA .EQ. -1 , PROGRAM USES BWID INPUT FROM CALLING ROUTINE
      IF (naa .EQ. -1)  GO TO 150
   10 na = naa - 1
      IF (na .LT. 1)  na = 1
C          GET NOMINAL BIN WIDTH IN EXPON FORM
   20 awid = (ah-al)/float(na)
      log = int(dlog10(dble(awid)))
      IF (awid .LE. one)  log=log-1
      sigfig = awid * (10.00 **(-log))
C         ROUND MANTISSA UP TO 2, 2.5, 5, OR 10
      IF(sigfig .GT. 2.0)  GO TO 40
      sigrnd = 2.0
      GO TO 100
   40 IF (sigfig .GT. 2.5)  GO TO 50
      sigrnd = 2.5
      GO TO 100
   50 IF(sigfig .GT. 5.0)  GO TO 60
      sigrnd =5.0
      GO TO 100
   60 sigrnd = 1.0
      log = log + 1
  100 CONTINUE
      bwid = sigrnd*10.0**log
      GO TO 200
C         GET NEW BOUNDS FROM NEW WIDTH BWID
  150 IF (bwid .LE. zero)  GO TO 10
  200 CONTINUE
      alb = al/bwid
      lwid=alb
      IF (alb .LT. zero)  lwid=lwid-1
      bl = bwid*float(lwid)
      alb = ah/bwid + 1.0
      kwid = alb
      IF (alb .LT. zero)  kwid=kwid-1
      bh = bwid*float(kwid)
      nb = kwid-lwid
      IF (naa .GT. 5)  GO TO 240
      IF (naa .EQ. -1)  RETURN
C          REQUEST FOR ONE BIN IS DIFFICULT CASE
      IF (naa .GT. 1 .OR. nb .EQ. 1)  RETURN
      bwid =  bwid*2.0
       nb  = 1
       RETURN
  240 IF (2*nb .NE. naa)  RETURN
      na = na + 1
      GO TO 20
      END