COSMOS v7.655  COSMOSv7655
(AirShowerMC)
mnbins.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine mnbins (A1, A2, NAA, BL, BH, NB, BWID)
 

Function/Subroutine Documentation

◆ mnbins()

subroutine mnbins (   A1,
  A2,
  NAA,
  BL,
  BH,
  NB,
  BWID 
)

Definition at line 10 of file mnbins.f.

References a, h, o, parameter(), and z.

Referenced by mnplot(), and mnscan().

10 *
11 * $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
12 *
13 * $Log: d506dp.inc,v $
14 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
15 * Minuit
16 *
17 *
18 *
19 *
20 * d506dp.inc
21 *
22 C ************ DOUBLE PRECISION VERSION *************
23  IMPLICIT DOUBLE PRECISION (a-h,o-z)
24 C SUBROUTINE TO DETERMINE REASONABLE HISTOGRAM INTERVALS
25 C GIVEN ABSOLUTE UPPER AND LOWER BOUNDS A1 AND A2
26 C AND DESIRED MAXIMUM NUMBER OF BINS NAA
27 C PROGRAM MAKES REASONABLE BINNING FROM BL TO BH OF WIDTH BWID
28 C F. JAMES, AUGUST, 1974 , stolen for Minuit, 1988
29  parameter(zero=0.0, one=1.0)
30  al = min(a1,a2)
31  ah = max(a1,a2)
32  IF (al.EQ.ah) ah = al + 1.
33 C IF NAA .EQ. -1 , PROGRAM USES BWID INPUT FROM CALLING ROUTINE
34  IF (naa .EQ. -1) GO TO 150
35  10 na = naa - 1
36  IF (na .LT. 1) na = 1
37 C GET NOMINAL BIN WIDTH IN EXPON FORM
38  20 awid = (ah-al)/float(na)
39  log = int(dlog10(dble(awid)))
40  IF (awid .LE. one) log=log-1
41  sigfig = awid * (10.00 **(-log))
42 C ROUND MANTISSA UP TO 2, 2.5, 5, OR 10
43  IF(sigfig .GT. 2.0) GO TO 40
44  sigrnd = 2.0
45  GO TO 100
46  40 IF (sigfig .GT. 2.5) GO TO 50
47  sigrnd = 2.5
48  GO TO 100
49  50 IF(sigfig .GT. 5.0) GO TO 60
50  sigrnd =5.0
51  GO TO 100
52  60 sigrnd = 1.0
53  log = log + 1
54  100 CONTINUE
55  bwid = sigrnd*10.0**log
56  GO TO 200
57 C GET NEW BOUNDS FROM NEW WIDTH BWID
58  150 IF (bwid .LE. zero) GO TO 10
59  200 CONTINUE
60  alb = al/bwid
61  lwid=alb
62  IF (alb .LT. zero) lwid=lwid-1
63  bl = bwid*float(lwid)
64  alb = ah/bwid + 1.0
65  kwid = alb
66  IF (alb .LT. zero) kwid=kwid-1
67  bh = bwid*float(kwid)
68  nb = kwid-lwid
69  IF (naa .GT. 5) GO TO 240
70  IF (naa .EQ. -1) RETURN
71 C REQUEST FOR ONE BIN IS DIFFICULT CASE
72  IF (naa .GT. 1 .OR. nb .EQ. 1) RETURN
73  bwid = bwid*2.0
74  nb = 1
75  RETURN
76  240 IF (2*nb .NE. naa) RETURN
77  na = na + 1
78  GO TO 20
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
nodes z
real(4), dimension(:), allocatable, save h
Definition: cNRLAtmos.f:28
real(4), save al
Definition: cNRLAtmos.f:22
struct ob o[NpMax]
Definition: Zprivate.h:34
real(4), save a
Definition: cNRLAtmos.f:20
real(4), save bl
Definition: cNRLAtmos.f:22
Here is the call graph for this function:
Here is the caller graph for this function: