← Back to branch summary

~maddevelopers/mg5amcnlo/WWW5_caching

« back to all changes in this revision

Viewing changes to users/mardelcourt/PROC_407857/PROC_407857/Source/hcurve.f

  • Committer: John Doe
  • Date: 2013-03-25 20:27:02 UTC
  • Revision ID: john.doe@gmail.com-20130325202702-5sk3t1r8h33ca4p4
first clean version

Show diffs side-by-side

added added

removed removed

Lines of Context:
users/mardelcourt/PROC_407857/PROC_407857/Source/hcurve.f
 
1
C--------------------------------------------
 
2
C
 
3
C               Routine to dump histogram data to a file
 
4
C
 
5
        subroutine hcurve(id,filename)  
 
6
C
 
7
C               Dumps current histogram number id to file 'filename' and
 
8
C               clears histogram id.
 
9
C
 
10
        include 'hbook.inc'
 
11
        character*(*) filename
 
12
        real sum,npts
 
13
 
 
14
        if (nhist .eq. 0) return
 
15
        open (unit=69,name=filename,status='unknown')
 
16
        do i = 1, nhist
 
17
                if (id .eq. idnumber(i)) go to 10
 
18
                end do
 
19
        return
 
20
10      continue
 
21
        k = pointer(i)
 
22
        nx = int(data(k)+.1)
 
23
        xmin = data(k+1)
 
24
        xmax = data(k+2)
 
25
        xbinsize = (xmax-xmin)/nx
 
26
        if (single dim(i)) then
 
27
           sum=0
 
28
           npts=0
 
29
           do m=1,nx
 
30
              sum=sum+data(k+2+m)
 
31
              npts=npts+npoints(k+2+m)
 
32
           enddo
 
33
           write (69,300) label(i)(1:labelleng(label(i)))
 
34
           write (69,700) (xmin+(m-.5)*xbinsize,
 
35
     $          data(k+2+m),sqrt(abs(error(k+2+m))),
 
36
     $          npoints(k+2+m)/(npts*sum+1e-23),m=1,nx)
 
37
        else
 
38
                ny = int(data(k+3) + .1)
 
39
                ymin = data(k+4)
 
40
                ymax = data(k+5)
 
41
                ybinsize = (ymax-ymin)/ny
 
42
                write (69,300) label(i)(1:labelleng(label(i)))
 
43
                k = k + 5
 
44
                do n=1,ny
 
45
                   fixed y =  ymin + (n-.5)*ybinsize
 
46
                   write (69,500) (xmin+(m-.5)*xbinsize,fixed y,
 
47
     $                  data(k+m),m=1,nx)
 
48
                   write(69,*) 
 
49
                   k = k + nx
 
50
                end do
 
51
                end if
 
52
        close (unit=69)
 
53
        return
 
54
300     format ('# Histogram ',a)
 
55
400     format (1x,2g15.6)
 
56
500     format (1x,3g15.6)
 
57
700     format (1x,4g15.6)
 
58
        end
 
59
C
 
60
C
 
61
C
 
62
C
 
63
        function labelleng(string)
 
64
        character*(*) string
 
65
 
 
66
        do i=len(string),1,-1
 
67
                if (string(i:i) .ne. ' ') then
 
68
                        labelleng=i
 
69
                        return
 
70
                        end if
 
71
                end do
 
72
        labelleng=1
 
73
        return
 
74
        end