1 cdaq  1.1       subroutine h_fill_dc_fp_hist(Abort,err)
 2           *
 3           *     routine to fill histograms with hms_focal_plane varibles
 4           *
 5           *     Author:	D. F. Geesaman
 6           *     Date:     30 March 1994
 7           *     Modified: 9 April 1994        DFG
 8           *                                   Transfer ID in common block
 9           *                                   Implement flag to turn block on

10 cdaq  1.2 * $Log: h_fill_dc_fp_hist.f,v $

11 cdaq  1.5 * Revision 1.4  1995/04/06  19:27:11  cdaq
12           * (JRA) Rename residuals variables
13           *

14 cdaq  1.4 * Revision 1.3  1994/08/18  03:13:08  cdaq
15           * (SAW) Use arrays of histids for residuals
16           *

17 cdaq  1.3 * Revision 1.2  1994/08/18  02:35:36  cdaq
18           * (DA) Add histograms for residuals
19           *

20 cdaq  1.2 * Revision 1.1  1994/04/13  15:38:48  cdaq
21           * Initial revision
22           *

23 cdaq  1.1 *-
24           *--------------------------------------------------------

25 cdaq  1.2       IMPLICIT NONE

26 cdaq  1.1 *

27 cdaq  1.2       character*50 here
28                 parameter (here= 'h_fill_dc_fp_hist')

29 cdaq  1.1 *

30 cdaq  1.5       include 'hms_data_structures.cmn'

31 cdaq  1.3       include 'hms_track_histid.cmn'
32                 include 'hms_tracking.cmn'
33           *

34 cdaq  1.2       logical ABORT
35                 character*(*) err
36                 real*4  histval
37                 integer*4 itrk

38 cdaq  1.3       integer*4 plane

39 cdaq  1.1 *

40 cdaq  1.2       SAVE

41 cdaq  1.1 *--------------------------------------------------------
42           *

43 cdaq  1.2       ABORT= .FALSE.
44                 err= ' '

45 cdaq  1.1 *
46           * Is this histogram flag turned on

47 cdaq  1.2       if(hturnon_focal_plane_hist .ne. 0 ) then

48 cdaq  1.1 * Make sure there is at least 1 track
49                   if(HNTRACKS_FP .gt. 0 ) then
50           * Loop over all hits

51 cdaq  1.2           do itrk=1,HNTRACKS_FP
52                       call hf1(hidhx_fp,HX_FP(itrk),1.)
53                       call hf1(hidhy_fp,HY_FP(itrk),1.)
54                       call hf1(hidhxp_fp,HXP_FP(itrk),1.)
55                       call hf1(hidhyp_fp,HYP_FP(itrk),1.)
56                       if(HCHI2_FP(itrk) .gt. 0 ) then
57                         histval=log10(HCHI2_FP(itrk))            
58                       else 
59                         histval = 10.
60                       endif
61                       call hf1(hidhlogchi2_fp,histval,1.)
62                       histval= HNFREE_FP(itrk)
63                       call hf1(hidhnfree_fp,histval,1.)
64                       if( HNFREE_FP(itrk) .ne.0) then
65                         histval= HCHI2_FP(itrk) /  HNFREE_FP(itrk)
66                       else
67                         histval = -1.

68 cdaq  1.1             endif
69                       call hf1(hidhchi2perdeg_fp,histval,1.)

70 cdaq  1.2 *     

71 cdaq  1.3             do plane = 1,hdc_num_planes

72 cdaq  1.4               call hf1(hidres_fp(plane),hdc_double_residual(itrk,plane),1.)
73                         call hf1(hidsingres_fp(plane),hdc_single_residual(itrk,plane),1.)

74 cdaq  1.3             enddo
75           

76 cdaq  1.2           enddo                         ! end loop over hits
77                   endif                           ! end test on zero hits       
78                 endif                             ! end test on histogramming flag

79 cdaq  1.1       RETURN
80                 END