| [2403] | 1 | * | 
|---|
|  | 2 | * $Id: mnbins.F,v 1.1.1.1 2003-06-11 14:18:26 cmv Exp $ | 
|---|
|  | 3 | * | 
|---|
|  | 4 | * $Log: not supported by cvs2svn $ | 
|---|
|  | 5 | * Revision 1.1.1.1  1996/03/07 14:31:28  mclareni | 
|---|
|  | 6 | * Minuit | 
|---|
|  | 7 | * | 
|---|
|  | 8 | * | 
|---|
|  | 9 | #include "minuit/pilot.h" | 
|---|
|  | 10 | SUBROUTINE MNBINS(A1,A2,NAA,BL,BH,NB,BWID) | 
|---|
|  | 11 | #include "minuit/d506dp.inc" | 
|---|
|  | 12 | C         SUBROUTINE TO DETERMINE REASONABLE HISTOGRAM INTERVALS | 
|---|
|  | 13 | C         GIVEN ABSOLUTE UPPER AND LOWER BOUNDS  A1 AND A2 | 
|---|
|  | 14 | C         AND DESIRED MAXIMUM NUMBER OF BINS NAA | 
|---|
|  | 15 | C         PROGRAM MAKES REASONABLE BINNING FROM BL TO BH OF WIDTH BWID | 
|---|
|  | 16 | C         F. JAMES,   AUGUST, 1974 , stolen for Minuit, 1988 | 
|---|
|  | 17 | PARAMETER (ZERO=0.0, ONE=1.0) | 
|---|
|  | 18 | AL = MIN(A1,A2) | 
|---|
|  | 19 | AH = MAX(A1,A2) | 
|---|
|  | 20 | IF (AL.EQ.AH)  AH = AL + 1. | 
|---|
|  | 21 | C         IF NAA .EQ. -1 , PROGRAM USES BWID INPUT FROM CALLING ROUTINE | 
|---|
|  | 22 | IF (NAA .EQ. -1)  GO TO 150 | 
|---|
|  | 23 | 10 NA = NAA - 1 | 
|---|
|  | 24 | IF (NA .LT. 1)  NA = 1 | 
|---|
|  | 25 | C          GET NOMINAL BIN WIDTH IN EXPON FORM | 
|---|
|  | 26 | 20 AWID = (AH-AL)/FLOAT(NA) | 
|---|
|  | 27 | LOG = INT(DLOG10(DBLE(AWID))) | 
|---|
|  | 28 | IF (AWID .LE. ONE)  LOG=LOG-1 | 
|---|
|  | 29 | SIGFIG = AWID * (10.00 **(-LOG)) | 
|---|
|  | 30 | C         ROUND MANTISSA UP TO 2, 2.5, 5, OR 10 | 
|---|
|  | 31 | IF(SIGFIG .GT. 2.0)  GO TO 40 | 
|---|
|  | 32 | SIGRND = 2.0 | 
|---|
|  | 33 | GO TO 100 | 
|---|
|  | 34 | 40 IF (SIGFIG .GT. 2.5)  GO TO 50 | 
|---|
|  | 35 | SIGRND = 2.5 | 
|---|
|  | 36 | GO TO 100 | 
|---|
|  | 37 | 50 IF(SIGFIG .GT. 5.0)  GO TO 60 | 
|---|
|  | 38 | SIGRND =5.0 | 
|---|
|  | 39 | GO TO 100 | 
|---|
|  | 40 | 60 SIGRND = 1.0 | 
|---|
|  | 41 | LOG = LOG + 1 | 
|---|
|  | 42 | 100 CONTINUE | 
|---|
|  | 43 | BWID = SIGRND*10.0**LOG | 
|---|
|  | 44 | GO TO 200 | 
|---|
|  | 45 | C         GET NEW BOUNDS FROM NEW WIDTH BWID | 
|---|
|  | 46 | 150 IF (BWID .LE. ZERO)  GO TO 10 | 
|---|
|  | 47 | 200 CONTINUE | 
|---|
|  | 48 | ALB = AL/BWID | 
|---|
|  | 49 | LWID=ALB | 
|---|
|  | 50 | IF (ALB .LT. ZERO)  LWID=LWID-1 | 
|---|
|  | 51 | BL = BWID*FLOAT(LWID) | 
|---|
|  | 52 | ALB = AH/BWID + 1.0 | 
|---|
|  | 53 | KWID = ALB | 
|---|
|  | 54 | IF (ALB .LT. ZERO)  KWID=KWID-1 | 
|---|
|  | 55 | BH = BWID*FLOAT(KWID) | 
|---|
|  | 56 | NB = KWID-LWID | 
|---|
|  | 57 | IF (NAA .GT. 5)  GO TO 240 | 
|---|
|  | 58 | IF (NAA .EQ. -1)  RETURN | 
|---|
|  | 59 | C          REQUEST FOR ONE BIN IS DIFFICULT CASE | 
|---|
|  | 60 | IF (NAA .GT. 1 .OR. NB .EQ. 1)  RETURN | 
|---|
|  | 61 | BWID =  BWID*2.0 | 
|---|
|  | 62 | NB  = 1 | 
|---|
|  | 63 | RETURN | 
|---|
|  | 64 | 240 IF (2*NB .NE. NAA)  RETURN | 
|---|
|  | 65 | NA = NA + 1 | 
|---|
|  | 66 | GO TO 20 | 
|---|
|  | 67 | END | 
|---|