HBTP code imported (P.Skowronski)
authorhristov <hristov@f7af4fe6-9843-0410-8265-dc069ae4e863>
Thu, 27 Sep 2001 16:30:22 +0000 (16:30 +0000)
committerhristov <hristov@f7af4fe6-9843-0410-8265-dc069ae4e863>
Thu, 27 Sep 2001 16:30:22 +0000 (16:30 +0000)
21 files changed:
HBTP/Makefile [new file with mode: 0644]
HBTP/common_correlations.inc [new file with mode: 0644]
HBTP/common_coulomb.inc [new file with mode: 0644]
HBTP/common_event_summary.inc [new file with mode: 0644]
HBTP/common_histograms.inc [new file with mode: 0644]
HBTP/common_mesh.inc [new file with mode: 0644]
HBTP/common_parameters.inc [new file with mode: 0644]
HBTP/common_particle.inc [new file with mode: 0644]
HBTP/common_sec_track.inc [new file with mode: 0644]
HBTP/common_sec_track2.inc [new file with mode: 0644]
HBTP/common_track.inc [new file with mode: 0644]
HBTP/common_track2.inc [new file with mode: 0644]
HBTP/dummyhbtproc.f [new file with mode: 0644]
HBTP/hbt_event_processor.f [new file with mode: 0644]
HBTP/hbt_particle_st.inc [new file with mode: 0644]
HBTP/hbt_sec_track2_st.inc [new file with mode: 0644]
HBTP/hbt_sec_track_st.inc [new file with mode: 0644]
HBTP/hbt_track2_st.inc [new file with mode: 0644]
HBTP/hbt_track_st.inc [new file with mode: 0644]
HBTP/ranlux.f [new file with mode: 0644]
HBTP/ranlux2.f [new file with mode: 0644]

diff --git a/HBTP/Makefile b/HBTP/Makefile
new file mode 100644 (file)
index 0000000..2808a22
--- /dev/null
@@ -0,0 +1,73 @@
+############################### HBTPROCESSOR Makefile ###############################
+
+# Include machine specific definitions
+
+include $(ALICE_ROOT)/conf/GeneralDef
+include $(ALICE_ROOT)/conf/MachineDef.$(ALICE_TARGET)
+
+PACKAGE = HBTPROCESSOR
+MAKEFLAGS =
+
+# C sources
+
+CSRCS         = 
+
+
+# C Objects
+
+COBJS         = $(patsubst %.c,tgt_$(ALICE_TARGET)/%.o,$(CSRCS))
+
+##### MACROS #####
+
+FSRCS  =  hbt_event_processor.f
+#hbt_event_processor.f
+
+FOBJS  = $(patsubst %.f,tgt_$(ALICE_TARGET)/%.o,$(FSRCS))
+
+SRCS   = $(FSRCS) $(CSRCS)
+OBJS   = $(FOBJS) $(COBJS)
+
+DSRCS  = dummyhbtproc.f
+#dummyhbtprocessor.f
+
+DOBJS  = $(patsubst %.f,tgt_$(ALICE_TARGET)/%.o,$(DSRCS))
+
+# C++ compilation flags
+
+CXXFLAGS      = $(CXXOPTS) $(CLIBCXXOPTS) $(CLIBDEFS)
+# C compilation flags
+
+CFLAGS      = $(COPT) $(CLIBCOPT) $(CLIBDEFS)
+# FORTRAN compilation flags
+
+FFLAGS      = $(FOPT) $(CLIBFOPT) $(CLIBDEFS)
+##### TARGETS #####
+# Target
+
+SLIBRARY       = $(LIBDIR)/libhbtprocessor.$(SL) $(LIBDIR)/libdummyhbtproc.$(SL)
+ALIBRARY       = $(LIBDIR)/libhbtprocessor.a $(LIBDIR)/dummyhbtprocessor.a
+
+default:       $(SLIBRARY)
+
+$(LIBDIR)/libhbtprocessor.$(SL):  $(OBJS)
+$(LIBDIR)/libdummyhbtproc.$(SL):  $(DOBJS)
+
+depend:                        $(CSRCS) $(DSRCS)
+
+TOCLEAN                = $(OBJS) $(DOBJS) *Cint.cxx *Cint.h
+
+############################### General Macros ################################
+
+include $(ALICE_ROOT)/conf/GeneralMacros
+
+############################ Dependencies #####################################
+
+-include tgt_$(ALICE_TARGET)/Make-depend 
+
+clean:
+       rm -f $(SLIBRARY) $(OBJS) $(DOBJS)
+
diff --git a/HBTP/common_correlations.inc b/HBTP/common_correlations.inc
new file mode 100644 (file)
index 0000000..e3104ba
--- /dev/null
@@ -0,0 +1,56 @@
+CCC   common/correlations/
+C
+C     This common block includes the following data:
+C
+C          o Two-Body Correlation Arrays for the following cases:
+C            - c2mod*  =  Model
+C            - c2fit*  =  Fitted
+C            - c2err*  =  Errors for fitted
+C
+C            Where (*) denotes the following cases:
+C                      Like Pairs,   1D dist
+C                      Unlike Pairs, 1D dist
+C                      Like Pairs,   3D dist, Fine Mesh
+C                      Unlike Pairs, 3D dist, Fine Mesh
+C                      Like Pairs,   3D dist, Coarse Mesh
+C                      Unlike Pairs, 3D dist, Coarse Mesh
+
+      integer*4 max_c2_1d, max_c2_3d
+      parameter (max_c2_1d = 100)
+      parameter (max_c2_3d =  10)
+
+      common/correlations/
+     1  c2mod_like_1d(max_c2_1d), c2mod_unlike_1d(max_c2_1d),
+     2  c2fit_like_1d(max_c2_1d), c2fit_unlike_1d(max_c2_1d),
+     3  c2err_like_1d(max_c2_1d), c2err_unlike_1d(max_c2_1d),
+     4  c2mod_like_3d_fine(max_c2_3d,max_c2_3d,max_c2_3d),
+     5  c2mod_unlike_3d_fine(max_c2_3d,max_c2_3d,max_c2_3d),
+     6  c2mod_like_3d_coarse(max_c2_3d,max_c2_3d,max_c2_3d),
+     7  c2mod_unlike_3d_coarse(max_c2_3d,max_c2_3d,max_c2_3d),
+     4  c2fit_like_3d_fine(max_c2_3d,max_c2_3d,max_c2_3d),
+     5  c2fit_unlike_3d_fine(max_c2_3d,max_c2_3d,max_c2_3d),
+     6  c2fit_like_3d_coarse(max_c2_3d,max_c2_3d,max_c2_3d),
+     7  c2fit_unlike_3d_coarse(max_c2_3d,max_c2_3d,max_c2_3d),
+     4  c2err_like_3d_fine(max_c2_3d,max_c2_3d,max_c2_3d),
+     5  c2err_unlike_3d_fine(max_c2_3d,max_c2_3d,max_c2_3d),
+     6  c2err_like_3d_coarse(max_c2_3d,max_c2_3d,max_c2_3d),
+     7  c2err_unlike_3d_coarse(max_c2_3d,max_c2_3d,max_c2_3d)
+
+CCC   Variable Type Declarations:
+
+CCC   One-dimensional Functions:
+
+      real*4 c2mod_like_1d, c2mod_unlike_1d
+      real*4 c2fit_like_1d, c2fit_unlike_1d
+      real*4 c2err_like_1d, c2err_unlike_1d
+
+CCC   Three-dimensional Functions:
+
+      real*4 c2mod_like_3d_fine,   c2mod_unlike_3d_fine
+      real*4 c2mod_like_3d_coarse, c2mod_unlike_3d_coarse
+      real*4 c2fit_like_3d_fine,   c2fit_unlike_3d_fine
+      real*4 c2fit_like_3d_coarse, c2fit_unlike_3d_coarse
+      real*4 c2err_like_3d_fine,   c2err_unlike_3d_fine
+      real*4 c2err_like_3d_coarse, c2err_unlike_3d_coarse
+
+CCC   END common/correlations/
diff --git a/HBTP/common_coulomb.inc b/HBTP/common_coulomb.inc
new file mode 100644 (file)
index 0000000..eeeac79
--- /dev/null
@@ -0,0 +1,40 @@
+CCC   common/coulmb/
+C
+C     This common block includes the following data:
+C
+C          o input q mesh (GeV/c) 
+C          o interpolated Coulomb correction for a specified
+C            Coulomb source size (input as parameter Q0 when
+C            switch_coulomb = 3) for both like and unlike pairs.
+C        
+C          The correction corresponds to John Cramer's tabulation
+C          of Scott Pratt's Coulomb wave function integration code
+C          results for finite size spherical sources.  The present
+C          code reads these tables and interpolates to the requested
+C          source radius.
+C
+C          The input source radii, the number of input files of data
+C          and the q-space grid are assumed static and are therefore
+C          hard-coded as follows:
+
+      integer*4 max_c2_coul         ! # q-mesh pts for input Coul. correc.
+      integer*4 ncoulradsteps       ! # input radii values (= # files)
+      parameter (max_c2_coul = 288)
+      parameter (ncoulradsteps = 7)
+
+      real*4 coulradmin     ! min source radius (fm) for Coul Correc. tables
+      real*4 coulradmax     ! max source radius (fm) for Coul Correc. tables
+      real*4 coulradstep    ! Source radius step size for Coul Correc. tables
+      parameter (coulradmin  =  6.0)
+      parameter (coulradmax  = 18.0)
+      parameter (coulradstep =  2.0)
+
+      common/coulmb/
+     1   c2_coul_like(max_c2_coul),c2_coul_unlike(max_c2_coul),
+     2   q_coul(max_c2_coul)
+
+      real*4 c2_coul_like   ! Finite source size Coul. correc for like pairs
+      real*4 c2_coul_unlike ! Finite source size Coul. correc for unlike pairs
+      real*4 q_coul         ! Momentum transfer grid (GeV/c).
+
+CCC   END common/coulmb/
diff --git a/HBTP/common_event_summary.inc b/HBTP/common_event_summary.inc
new file mode 100644 (file)
index 0000000..493aea0
--- /dev/null
@@ -0,0 +1,56 @@
+CCC   common/event_summary/
+C
+C     This common block includes the following data:
+C
+C          o Event processing summary and diagnostic information
+C          o Chi-Square values
+
+      integer*4 max_events            ! Limit on stored values, this is NOT
+C                                     ! a limit on the number of events that
+C                                     ! can be processed in the input event
+C                                     ! text file.
+      parameter (max_events = 100)
+
+      common/event_summary/
+     1num_iter(max_events), niter_mean, niter_rms,
+     2n_part_used_1_store(max_events), npart1_mean, npart1_rms,
+     3n_part_used_2_store(max_events), npart2_mean, npart2_rms,
+     4n_part_tot_store(max_events), npart_tot_mean, npart_tot_rms,
+     5num_sec_flagged_store(max_events), nsec_flag_mean, nsec_flag_rms,
+     6frac_trks_out(max_events), frac_trks_out_mean,frac_trks_out_rms,
+     7frac_trks_flag(max_events),frac_trks_flag_mean,frac_trks_flag_rms,
+     8chisq_like_1d_store(max_events),         chi_l1d_mean,chi_l1d_rms,
+     9chisq_unlike_1d_store(max_events),       chi_u1d_mean,chi_u1d_rms,
+     1chisq_like_3d_fine_store(max_events),    chi_l3f_mean,chi_l3f_rms,
+     2chisq_unlike_3d_fine_store(max_events),  chi_u3f_mean,chi_u3f_rms,
+     3chisq_like_3d_coarse_store(max_events),  chi_l3c_mean,chi_l3c_rms,
+     4chisq_unlike_3d_coarse_store(max_events),chi_u3c_mean,chi_u3c_rms,
+     5chisq_hist1_1_store(max_events), chi_1_1_mean, chi_1_1_rms,
+     6chisq_hist1_2_store(max_events), chi_1_2_mean, chi_1_2_rms,
+     7chisq_total_store(max_events), chi_tot_mean, chi_tot_rms
+
+CCC   Variable Type Declarations:
+
+CCC   Event processing summary and diagnostic information:
+
+      real*4 num_iter, niter_mean, niter_rms
+      real*4 n_part_used_1_store, npart1_mean, npart1_rms
+      real*4 n_part_used_2_store, npart2_mean, npart2_rms
+      real*4 n_part_tot_store, npart_tot_mean, npart_tot_rms
+      real*4 num_sec_flagged_store, nsec_flag_mean, nsec_flag_rms
+      real*4 frac_trks_out, frac_trks_out_mean,frac_trks_out_rms
+      real*4 frac_trks_flag,frac_trks_flag_mean,frac_trks_flag_rms
+
+CCC   Chi-Square values:
+
+      real*4 chisq_like_1d_store,         chi_l1d_mean,chi_l1d_rms
+      real*4 chisq_unlike_1d_store,       chi_u1d_mean,chi_u1d_rms
+      real*4 chisq_like_3d_fine_store,    chi_l3f_mean,chi_l3f_rms
+      real*4 chisq_unlike_3d_fine_store,  chi_u3f_mean,chi_u3f_rms
+      real*4 chisq_like_3d_coarse_store,  chi_l3c_mean,chi_l3c_rms
+      real*4 chisq_unlike_3d_coarse_store,chi_u3c_mean,chi_u3c_rms
+      real*4 chisq_hist1_1_store, chi_1_1_mean, chi_1_1_rms
+      real*4 chisq_hist1_2_store, chi_1_2_mean, chi_1_2_rms
+      real*4 chisq_total_store, chi_tot_mean, chi_tot_rms
+
+CCC   END common/event_summary/
diff --git a/HBTP/common_histograms.inc b/HBTP/common_histograms.inc
new file mode 100644 (file)
index 0000000..4ed64ee
--- /dev/null
@@ -0,0 +1,111 @@
+CCC   common/histograms/
+C
+C     This common block includes the following data:
+C
+C          o One- and Two-Body Histograms:
+C   
+C            One-Body:  hist1* - Originally filled and updated after each
+C                                iteration where Chi-Square is improved.
+C                       htmp1* - Working copy used within the track adjustment
+C                                iteration loop
+C                       href1* - Fixed reference distributions obtained from
+C                                event text input file for all events.
+C                       hinc1* - Inclusive event sum of all final, fitted
+C                                one-body distributions
+C
+C                                (*) denotes pt,phi,eta and PID#1,2
+C                                NOTE: The pt,phi,eta distributions are
+C                                      projections of the full, 3D dist.
+C                                      onto these axes.
+C
+C            Two-Body:  hist* - Originally filled and updated after each
+C                               iteration where Chi-Square is improved.
+C                       htmp* - Working copy used within the track adjustment
+C                               iteration loop
+C                       href* - Fixed reference distributions obtained from
+C                               event text input file for all events.
+C                       hinc* - Inclusive event sum of all final, fitted
+C                               two-body distributions
+C
+C                               (*) denotes arrays for the following:
+C                                   - Like pairs,   1D distributions
+C                                   - Unlike pairs, 1D distributions           
+C                                   - Like pairs,   3D dist., Fine Mesh
+C                                   - Unlike pairs, 3D dist., Fine Mesh
+C                                   - Like pairs,   3D dist., Coarse Mesh
+C                                   - Unlike pairs, 3D dist., Coarse Mesh
+
+      integer*4 max_h_1d, max_h_3d
+      parameter (max_h_1d = 100)
+      parameter (max_h_3d = 10 )
+
+      common/histograms/
+     1 hist1_pt_1(max_h_1d),hist1_phi_1(max_h_1d),hist1_eta_1(max_h_1d),
+     2 hist1_pt_2(max_h_1d),hist1_phi_2(max_h_1d),hist1_eta_2(max_h_1d),
+     3 htmp1_pt_1(max_h_1d),htmp1_phi_1(max_h_1d),htmp1_eta_1(max_h_1d),
+     4 htmp1_pt_2(max_h_1d),htmp1_phi_2(max_h_1d),htmp1_eta_2(max_h_1d),
+     5 href1_pt_1(max_h_1d),href1_phi_1(max_h_1d),href1_eta_1(max_h_1d),
+     6 href1_pt_2(max_h_1d),href1_phi_2(max_h_1d),href1_eta_2(max_h_1d),
+     7 hinc1_pt_1(max_h_1d),hinc1_phi_1(max_h_1d),hinc1_eta_1(max_h_1d),
+     8 hinc1_pt_2(max_h_1d),hinc1_phi_2(max_h_1d),hinc1_eta_2(max_h_1d),
+     9 hist_like_1d(max_h_1d),hist_unlike_1d(max_h_1d),
+     1 htmp_like_1d(max_h_1d),htmp_unlike_1d(max_h_1d),
+     2 href_like_1d(max_h_1d),href_unlike_1d(max_h_1d),
+     3 hinc_like_1d(max_h_1d),hinc_unlike_1d(max_h_1d),
+     4 hist_like_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     5 hist_unlike_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     6 hist_like_3d_coarse(max_h_3d,max_h_3d,max_h_3d),
+     7 hist_unlike_3d_coarse(max_h_3d,max_h_3d,max_h_3d),
+     4 htmp_like_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     5 htmp_unlike_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     6 htmp_like_3d_coarse(max_h_3d,max_h_3d,max_h_3d),
+     7 htmp_unlike_3d_coarse(max_h_3d,max_h_3d,max_h_3d),
+     4 href_like_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     5 href_unlike_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     6 href_like_3d_coarse(max_h_3d,max_h_3d,max_h_3d),
+     7 href_unlike_3d_coarse(max_h_3d,max_h_3d,max_h_3d),
+     4 hinc_like_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     5 hinc_unlike_3d_fine(max_h_3d,max_h_3d,max_h_3d),
+     6 hinc_like_3d_coarse(max_h_3d,max_h_3d,max_h_3d),
+     7 hinc_unlike_3d_coarse(max_h_3d,max_h_3d,max_h_3d)
+
+CCC   Variable Type Declarations:
+
+CCC   One-Body Distributions:
+
+      integer*4 hist1_pt_1,hist1_phi_1,hist1_eta_1
+      integer*4 hist1_pt_2,hist1_phi_2,hist1_eta_2
+      integer*4 htmp1_pt_1,htmp1_phi_1,htmp1_eta_1
+      integer*4 htmp1_pt_2,htmp1_phi_2,htmp1_eta_2
+      integer*4 href1_pt_1,href1_phi_1,href1_eta_1
+      integer*4 href1_pt_2,href1_phi_2,href1_eta_2
+      integer*4 hinc1_pt_1,hinc1_phi_1,hinc1_eta_1
+      integer*4 hinc1_pt_2,hinc1_phi_2,hinc1_eta_2
+
+CCC   Two-Body Distributions 1D:
+
+      integer*4 hist_like_1d, hist_unlike_1d
+      integer*4 htmp_like_1d, htmp_unlike_1d
+      integer*4 href_like_1d, href_unlike_1d
+      integer*4 hinc_like_1d, hinc_unlike_1d
+
+CCC   Two-Body Distributions 3D:
+
+      integer*4 hist_like_3d_fine
+      integer*4 hist_unlike_3d_fine
+      integer*4 hist_like_3d_coarse
+      integer*4 hist_unlike_3d_coarse
+      integer*4 htmp_like_3d_fine
+      integer*4 htmp_unlike_3d_fine
+      integer*4 htmp_like_3d_coarse
+      integer*4 htmp_unlike_3d_coarse
+      integer*4 href_like_3d_fine
+      integer*4 href_unlike_3d_fine
+      integer*4 href_like_3d_coarse
+      integer*4 href_unlike_3d_coarse
+      integer*4 hinc_like_3d_fine
+      integer*4 hinc_unlike_3d_fine
+      integer*4 hinc_like_3d_coarse
+      integer*4 hinc_unlike_3d_coarse
+
+CCC   END common/histograms/
diff --git a/HBTP/common_mesh.inc b/HBTP/common_mesh.inc
new file mode 100644 (file)
index 0000000..7ca8bf1
--- /dev/null
@@ -0,0 +1,89 @@
+CCC   common/mesh/
+C
+C     This common block includes the following data:
+C
+C          o Mesh Bin Definitions for the following:
+C            i) One-Body distributions in {pt,phi,eta}
+C           ii) Two-Body Histograms and Correlations for 1D and 3D
+C          iii) Momentum space sectors for track sorting in {px,py,pz}
+
+      integer*4 max_trk_save
+      parameter (max_trk_save = 150)
+
+      common/mesh/
+     1   n_pt_bins,n_phi_bins,n_eta_bins,
+     2   n_1d_fine,n_1d_coarse,n_1d_total,
+     3   n_3d_fine,n_3d_coarse,n_3d_total,n_3d_fine_project,
+     4   n_px_bins,n_py_bins,n_pz_bins,n_sectors,
+     5   old_sec_ntrk,old_sec_flag,old_sec_trkid(max_trk_save),
+     6   new_sec_ntrk,new_sec_flag,new_sec_trkid(max_trk_save),
+     7   new_sec_save,old_sec_save,
+     8   pt_bin_size,pt_min,pt_max,
+     9   phi_bin_size,phi_min,phi_max,
+     1   eta_bin_size,eta_min,eta_max,
+     2   binsize_1d_fine,binsize_1d_coarse,qmid_1d,qmax_1d,
+     3   binsize_3d_fine,binsize_3d_coarse,qmid_3d,qmax_3d,
+     4   px_min,px_max,delpx,
+     5   py_min,py_max,delpy,
+     6   pz_min,pz_max,delpz
+
+CCC   Variable Type Declarations:
+
+CCC   One-Body Mesh:
+
+      integer*4 n_pt_bins             ! # one-body pt bins
+      integer*4 n_phi_bins            ! # one-body phi bins
+      integer*4 n_eta_bins            ! # one-body eta bins
+      real*4    pt_bin_size           ! One-body pt bin size in (GeV/c)
+      real*4    phi_bin_size          ! One-body phi bin size in (degrees)
+      real*4    eta_bin_size          ! One-body eta bin size
+      real*4    pt_min, pt_max        ! One-body pt min/max in (GeV/c)
+      real*4    phi_min, phi_max      ! One-body phi min/max in (degrees)
+      real*4    eta_min, eta_max      ! One-body eta min/max
+
+CCC   Two-Body Histograms and Correlation Mesh for 1D and 3D distributions:
+
+      integer*4 n_1d_fine             ! # bins for 1D, Fine Mesh
+      integer*4 n_1d_coarse           ! # bins for 1D, Coarse Mesh
+      integer*4 n_1d_total            ! Total # bins for 1D
+      integer*4 n_3d_fine             ! # bins for 3D, Fine Mesh
+      integer*4 n_3d_coarse           ! # bins for 3D, Coarse Mesh
+      integer*4 n_3d_total            ! Total # bins for 3D
+      integer*4 n_3d_fine_project     ! # 3D fine mesh bins to sum over for
+C                                     ! projections onto single axis.
+
+      real*4    binsize_1d_fine       ! Bin Size - 1D, Fine Mesh in (GeV/c)
+      real*4    binsize_1d_coarse     ! Bin Size - 1D, Coarse Mesh in (GeV/c)
+      real*4    qmid_1d               ! q (GeV/c) at fine-coarse mesh boundary
+      real*4    qmax_1d               ! Max q (GeV/c) for 1D distributions
+      real*4    binsize_3d_fine       ! Bin Size - 3D, Fine Mesh in (GeV/c)
+      real*4    binsize_3d_coarse     ! Bin Size - 3D, Coarse Mesh in (GeV/c)
+      real*4    qmid_3d               ! q (GeV/c) at fine-coarse mesh boundary
+      real*4    qmax_3d               ! Max q (GeV/c) for 3D distributions
+
+CCC   Momentum Space Sectors for Track Sorting:
+
+      integer*4 n_px_bins             ! # sector bins in px
+      integer*4 n_py_bins             ! # sector bins in py
+      integer*4 n_pz_bins             ! # sector bins in pz
+      integer*4 n_sectors             ! Total # sectors in 3D momentum space
+
+      real*4    delpx                 ! Mom. space sector cell size - px(GeV/c)
+      real*4    delpy                 ! Mom. space sector cell size - py(GeV/c)
+      real*4    delpz                 ! Mom. space sector cell size - pz(GeV/c)
+      real*4    px_min, px_max        ! Sector range in px in GeV/c
+      real*4    py_min, py_max        ! Sector range in py in GeV/c
+      real*4    pz_min, pz_max        ! Sector range in pz in GeV/c
+
+CCC   Temporary Momentum Space Sector information storage during trk adjust.
+
+      integer*4 old_sec_ntrk          ! Old sector # tracks
+      integer*4 old_sec_flag          ! Old sector flag value
+      integer*4 old_sec_trkid         ! Old sector track id array
+      integer*4 old_sec_save          ! Old sector ID value
+      integer*4 new_sec_ntrk          ! New sector # tracks
+      integer*4 new_sec_flag          ! New sector flag value
+      integer*4 new_sec_trkid         ! New sector track id array
+      integer*4 new_sec_save          ! New sector ID value
+
+CCC   End common/mesh/
diff --git a/HBTP/common_parameters.inc b/HBTP/common_parameters.inc
new file mode 100644 (file)
index 0000000..1dc568e
--- /dev/null
@@ -0,0 +1,132 @@
+CCC   common/parameters/
+C
+C     This common block includes the following data:
+C
+C          o Run control switches
+C          o Correlation model selection switches
+C          o Correlation model parameters
+C          o Numbers of particles and pairs of particles
+C          o Track momentum adjustment parameters
+C          o Constants and Chi-Square values
+
+      common/parameters/
+     1   ALICE,errorcode,
+     2   ref_control,print_full,print_sector_data,n_pid_types,pid(2),
+     3   n_events,switch_1d,switch_3d,switch_type,switch_coherence,
+     4   switch_coulomb,switch_fermi_bose,n_part_1_trk,n_part_2_trk,
+     5   n_part_tot_trk,n_part_1_trk2,n_part_2_trk2,n_part_tot_trk2,
+     6   n_part_used_1_trk,n_part_used_2_trk,n_part_used_1_trk2,
+     7   n_part_used_2_trk2,n_part_used_1_ref,n_part_used_2_ref,
+     8   n_part_used_1_inc,n_part_used_2_inc,num_pairs_like,
+     9   num_pairs_unlike,num_pairs_like_ref,num_pairs_unlike_ref,
+     1   num_pairs_like_inc,num_pairs_unlike_inc,event_line_counter,
+     2   maxit,irand,file10_line_counter,
+     3   lambda,R_1d,Rside,Rout,Rlong,Rperp,Rparallel,R0,Q0,deltap,
+     4   delchi,pi,rad,hbc,chisq_wt_like_1d,chisq_wt_unlike_1d,
+     5   chisq_wt_like_3d_fine,chisq_wt_unlike_3d_fine,
+     6   chisq_wt_like_3d_coarse,chisq_wt_unlike_3d_coarse,
+     7   chisq_wt_hist1_1,chisq_wt_hist1_2,mass1,mass2,trk_accep
+
+CCC   Variable Type Declarations:
+
+CCC   ALICE specific variables, DATA I/O option and return error code
+
+      integer*4 ALICE                  ! To I/O from files or AliRoot strucs
+      integer*4 errorcode              ! Processor error code to stop
+CCC                                      calculation and return to calling 
+CCC                                      program.     
+CCC   Run Control and Model Switches:
+
+      integer*4 ref_control            ! Select Reference Histograms
+      integer*4 print_full             ! Full print out option - each event
+      integer*4 print_sector_data      ! Print sector overflow diagnostics
+      integer*4 n_pid_types            ! # particle ID types to correlate
+      integer*4 pid                    ! Geant particle ID #s, max of 2 types
+      integer*4 n_events               ! # events in input event text file
+      integer*4 switch_1d              ! Include 1D correlations
+      integer*4 switch_3d              ! Include 3D correlations
+      integer*4 switch_type            ! For like, unlike or both PID pairs
+      integer*4 switch_coherence       ! To include incoh/coher mixed source
+      integer*4 switch_coulomb         ! Coulomb correction selection options
+      integer*4 switch_fermi_bose      ! For fermions or bosons
+
+CCC   Numbers of particles and pairs:
+
+      integer*4 n_part_1_trk           ! Total # PID #1 in 'trk', all flags
+      integer*4 n_part_2_trk           ! Total # PID #2 in 'trk', all flags
+      integer*4 n_part_tot_trk         ! Total # all part. in 'trk', all flgs
+      integer*4 n_part_used_1_trk      ! # PID#1, used (flag=0) in 'trk'
+      integer*4 n_part_used_2_trk      ! # PID#2, used (flag=0) in 'trk'
+
+      integer*4 n_part_1_trk2          ! Total # PID #1 in 'trk2', all flags
+      integer*4 n_part_2_trk2          ! Total # PID #2 in 'trk2', all flags
+      integer*4 n_part_tot_trk2        ! Total # all part. in 'trk2', all flgs
+      integer*4 n_part_used_1_trk2     ! # PID#1, used (flag=0) in 'trk2'
+      integer*4 n_part_used_2_trk2     ! # PID#2, used (flag=0) in 'trk2'
+
+      integer*4 n_part_used_1_ref      ! # PID#1, used (flag=0) in Reference
+      integer*4 n_part_used_2_ref      ! # PID#2, used (flag=0) in Reference
+      integer*4 n_part_used_1_inc      ! # PID#1, used (flag=0) in Inclusive 
+      integer*4 n_part_used_2_inc      ! # PID#2, used (flag=0) in Inclusive
+
+      integer*4 num_pairs_like         ! # like pairs used (flag=0) in fit 
+      integer*4 num_pairs_unlike       ! # unlike pairs used (flag=0) in fit
+      integer*4 num_pairs_like_ref     ! # like pairs used (flag=0) in Ref. 
+      integer*4 num_pairs_unlike_ref   ! # unlike pairs used (flag=0) in Ref. 
+      integer*4 num_pairs_like_inc     ! # like pairs used (flag=0) in Incl. 
+      integer*4 num_pairs_unlike_inc   ! # unlike pairs used (flag=0) in Incl. 
+
+CCC   Counters:
+
+      integer*4 event_line_counter     ! Input event text file line counter
+      integer*4 file10_line_counter    ! Output, correlated event text file
+CCC                                    !    line counter
+
+CCC   Correlation Model Parameters:
+
+      real*4    lambda                 ! Chaoticity parameter
+      real*4    R_1d                   ! Spherical source radius (fm)
+      real*4    Rside                  ! 3D Bertsch-Pratt source 'side' R (fm)
+      real*4    Rout                   ! 3D Bertsch-Pratt source 'out'  R (fm)
+      real*4    Rlong                  ! 3D Bertsch-Pratt source 'long' R (fm)
+      real*4    Rperp                  ! 3D YKP source transverse radius  (fm)
+      real*4    Rparallel              ! 3D YKP source longitudinal radius(fm)
+      real*4    R0                     ! 3D YKP source emission time durat(fm)
+      real*4    Q0                     ! NA35 Coulomb parameter (GeV/c) or
+CCC                                    ! Coul radius for Pratt finite src (fm)
+
+CCC   Search Control Parameters:
+
+      integer*4 maxit                  ! Max # iterations in track adjustment
+      real*4    deltap                 ! Max limit for x,y,z momt shifts(GeV/c)
+      real*4    delchi                 ! Min% change in Chi-Sq to stop iterat.
+
+CCC   Chi-Square Values:
+
+      real*4    chisq_wt_like_1d          ! 1D, Like pairs
+      real*4    chisq_wt_unlike_1d        ! 1D, Unlike pairs
+      real*4    chisq_wt_like_3d_fine     ! 3D, Like pairs, Fine Mesh
+      real*4    chisq_wt_unlike_3d_fine   ! 3D, Unlike pairs, Fine Mesh
+      real*4    chisq_wt_like_3d_coarse   ! 3D, Like pairs, Coarse Mesh
+      real*4    chisq_wt_unlike_3d_coarse ! 3D, Unlike pairs, Coarse Mesh
+      real*4    chisq_wt_hist1_1          ! One-body, particle ID type #1
+      real*4    chisq_wt_hist1_2          ! One-body, particle ID type #2
+
+CCC   Particle Masses:
+
+      real*4    mass1, mass2           ! Particle ID# 1 and 2 masses (GeV)
+
+CCC   Constants:
+
+      integer*4 irand                  ! Random # starting seed (Def=12345)
+      real*4    pi, hbc                ! PI and h-bar-c (GeV*fm)
+      real*4    rad                    ! radian = 180.0/pi
+C     parameter (pi = 3.141592654)
+C     parameter (hbc = 0.19732891)
+
+CCC  Random Track Selection Fraction, for low multiplicity particles
+
+      real*4 trk_accep                 ! ranges from 0.0 -> 1.0
+
+CCC   END common/parameters/
+
diff --git a/HBTP/common_particle.inc b/HBTP/common_particle.inc
new file mode 100644 (file)
index 0000000..adcbcbd
--- /dev/null
@@ -0,0 +1,24 @@
+CCC   common/particle/
+C
+CCC   Geant Particle Properties:
+CCC   (Converted to common block for ALICE application, 12/1/2000)
+
+      Integer*4 part_maxlen
+      Parameter (part_maxlen = 50)
+
+      common/particle/
+     1  part_id(part_maxlen),
+     2  part_charge(part_maxlen),
+     3  part_mass(part_maxlen),
+     4  part_lifetime(part_maxlen)
+
+
+CCC   Variable Type Declarations:
+
+      Integer*4   part_id        ! Geant particle ID code number; required
+CCC                              ! to be equal to the row number
+      Integer*4   part_charge    ! Electric charge in units of |e|
+      Real*4      part_mass      ! Rest mass in GeV/c**2
+      Real*4      part_lifetime  ! Proper lifetime in sec. 
+
+CCC   END common/particle/
diff --git a/HBTP/common_sec_track.inc b/HBTP/common_sec_track.inc
new file mode 100644 (file)
index 0000000..c2b8cd4
--- /dev/null
@@ -0,0 +1,29 @@
+CCC   common/sec_trk_map/
+C
+CCC   Track-to-Sector Mapping data structure:
+CCC   (Converted to common block for ALICE application, 12/1/2000)
+
+      Integer*4 max_trk_sec
+      Integer*4 sec_maxlen
+      Parameter (max_trk_sec = 150)
+      Parameter (sec_maxlen  = 28000)
+
+      common/sec_trk_map/
+     1  stm_sec_id(sec_maxlen),
+     2  stm_n_trk_sec(sec_maxlen),
+     3  stm_flag(sec_maxlen),
+     4  stm_track_id(max_trk_sec,sec_maxlen)
+
+CCC   Variable Type Declarations:
+
+      Integer*4 stm_sec_id        !  unique sector ID number
+      Integer*4 stm_n_trk_sec     !  Number of tracks assigned to sector
+      Integer*4 stm_flag          !  normally=0, if = 1 then more than
+CCC                               !  max_trk_sec tracks could have been 
+CCC                               !  assigned to this sector, however the
+CCC                               !  maximum number that can be assigned is
+CCC                               !  max_trk_sec.
+      Integer*4 stm_track_id      !  Foreign keys to tracks in /track/ that
+CCC                               !  are assigned to this sector.
+
+CCC   END common/sec_trk_map/
diff --git a/HBTP/common_sec_track2.inc b/HBTP/common_sec_track2.inc
new file mode 100644 (file)
index 0000000..3dd94aa
--- /dev/null
@@ -0,0 +1,31 @@
+CCC   common/sec_trk_map2/
+C
+CCC   Second Track-to-Sector Mapping data structure:
+CCC   (Used for building the reference spectrum from the
+CCC    input event text file.)
+CCC   (Converted to common block for ALICE application, 12/1/2000)
+
+      Integer*4 max_trk_sec2
+      Integer*4 sec_maxlen2
+      Parameter (max_trk_sec2 = 150)
+      Parameter (sec_maxlen2  = 28000)
+
+      common/sec_trk_map2/
+     1  stm2_sec_id(sec_maxlen2),
+     2  stm2_n_trk_sec(sec_maxlen2),
+     3  stm2_flag(sec_maxlen2),
+     4  stm2_track_id(max_trk_sec2,sec_maxlen2)
+
+CCC   Variable Type Declarations:
+
+      Integer*4 stm2_sec_id       !  unique sector ID number
+      Integer*4 stm2_n_trk_sec    !  Number of tracks assigned to sector
+      Integer*4 stm2_flag         !  normally=0, if = 1 then more than
+CCC                               !  max_trk_sec tracks could have been 
+CCC                               !  assigned to this sector, however the
+CCC                               !  maximum number that can be assigned is
+CCC                               !  max_trk_sec.
+      Integer*4 stm2_track_id     !  Foreign keys to tracks in /track/ that
+CCC                               !  are assigned to this sector.
+
+CCC   END common/sec_trk_map2/
diff --git a/HBTP/common_track.inc b/HBTP/common_track.inc
new file mode 100644 (file)
index 0000000..4c3093d
--- /dev/null
@@ -0,0 +1,56 @@
+CCC   common/track/
+C
+CCC   Track Data Structure:
+CCC   (Converted to common block for ALICE application, 12/1/2000)
+
+      Integer*4 trk_maxlen
+      Parameter (trk_maxlen = 25000)
+
+      common/track1/
+     1  trk_id(trk_maxlen),
+     2  trk_px_sec(trk_maxlen),
+     3  trk_py_sec(trk_maxlen),
+     4  trk_pz_sec(trk_maxlen),
+     5  trk_sector(trk_maxlen),
+     6  trk_flag(trk_maxlen),
+     7  trk_out_flag(trk_maxlen),
+     8  trk_merge_flag(trk_maxlen),
+     9  trk_ge_pid(trk_maxlen),
+     1  trk_start_vertex(trk_maxlen),
+     2  trk_stop_vertex(trk_maxlen),
+     3  trk_event_line(trk_maxlen),
+     4  trk_px(trk_maxlen),
+     5  trk_py(trk_maxlen),
+     6  trk_pz(trk_maxlen),
+     7  trk_E(trk_maxlen),
+     8  trk_pt(trk_maxlen),
+     9  trk_phi(trk_maxlen),
+     1  trk_eta(trk_maxlen)
+
+CCC   Variable Type Declarations:
+
+      Integer*4   trk_id          ! Track ID number
+      Integer*4   trk_px_sec      ! px sector number
+      Integer*4   trk_py_sec      ! py sector number
+      Integer*4   trk_pz_sec      ! pz sector number
+      Integer*4   trk_sector      ! unique sector ID number
+      Integer*4   trk_flag        ! normally=0,if 1 indicates track assigned
+CCC                               ! to sector with too many tracks, if = 1
+CCC                               ! then track is not used.  See /sec_trk_map/ 
+      Integer*4   trk_out_flag    ! flag indicating track in/out of accept.
+CCC                               ! non-zero for track pushed out of accept.
+      Integer*4   trk_merge_flag  ! flag indicating track is merged (not used)
+      Integer*4   trk_ge_pid      ! Geant particle ID code number
+      Integer*4  trk_start_vertex ! From input event file - track's start vrtx
+      Integer*4  trk_stop_vertex  ! From input event file - track's stop vrtx
+      Integer*4   trk_event_line  ! Line # of track in input event text file
+      
+      Real*4      trk_px          ! x component of track momentum in GeV/c
+      Real*4      trk_py          ! y component of track momentum in GeV/c
+      Real*4      trk_pz          ! z component of track momentum in GeV/c
+      Real*4      trk_E           ! Total energy of track in GeV
+      Real*4      trk_pt          ! pt of track momentum in GeV/c
+      Real*4      trk_phi         ! azimuthal angle of track in degrees 
+      Real*4      trk_eta         ! pseudorapidity of track
+
+CCC   END common/track/
diff --git a/HBTP/common_track2.inc b/HBTP/common_track2.inc
new file mode 100644 (file)
index 0000000..7e1c1a7
--- /dev/null
@@ -0,0 +1,58 @@
+CCC   common/track2/
+C
+CCC   Second Track Data Structure:
+CCC   (This one is needed to build the reference spectrum from
+CCC    the event text input file.)
+CCC   (Converted to common block for ALICE application, 12/1/2000)
+
+      Integer*4 trk2_maxlen
+      Parameter (trk2_maxlen = 25000)
+
+      common/track2/
+     1  trk2_id(trk2_maxlen),
+     2  trk2_px_sec(trk2_maxlen),
+     3  trk2_py_sec(trk2_maxlen),
+     4  trk2_pz_sec(trk2_maxlen),
+     5  trk2_sector(trk2_maxlen),
+     6  trk2_flag(trk2_maxlen),
+     7  trk2_out_flag(trk2_maxlen),
+     8  trk2_merge_flag(trk2_maxlen),
+     9  trk2_ge_pid(trk2_maxlen),
+     1  trk2_start_vertex(trk2_maxlen),
+     2  trk2_stop_vertex(trk2_maxlen),
+     3  trk2_event_line(trk2_maxlen),
+     4  trk2_px(trk2_maxlen),
+     5  trk2_py(trk2_maxlen),
+     6  trk2_pz(trk2_maxlen),
+     7  trk2_E(trk2_maxlen),
+     8  trk2_pt(trk2_maxlen),
+     9  trk2_phi(trk2_maxlen),
+     1  trk2_eta(trk2_maxlen)
+
+CCC   Variable Type Declarations:
+
+      Integer*4   trk2_id          ! Track ID number
+      Integer*4   trk2_px_sec      ! px sector number
+      Integer*4   trk2_py_sec      ! py sector number
+      Integer*4   trk2_pz_sec      ! pz sector number
+      Integer*4   trk2_sector      ! unique sector ID number
+      Integer*4   trk2_flag        ! normally=0,if 1 indicates track assigned
+CCC                               ! to sector with too many tracks, if = 1
+CCC                               ! then track is not used.  See /sec_trk2_map/ 
+      Integer*4   trk2_out_flag    ! flag indicating track in/out of accept.
+CCC                               ! non-zero for track pushed out of accept.
+      Integer*4   trk2_merge_flag  ! flag indicating track is merged (not used)
+      Integer*4   trk2_ge_pid      ! Geant particle ID code number
+      Integer*4  trk2_start_vertex ! From input event file - track's start vrtx
+      Integer*4  trk2_stop_vertex  ! From input event file - track's stop vrtx
+      Integer*4   trk2_event_line  ! Line # of track in input event text file
+      
+      Real*4      trk2_px          ! x component of track momentum in GeV/c
+      Real*4      trk2_py          ! y component of track momentum in GeV/c
+      Real*4      trk2_pz          ! z component of track momentum in GeV/c
+      Real*4      trk2_E           ! Total energy of track in GeV
+      Real*4      trk2_pt          ! pt of track momentum in GeV/c
+      Real*4      trk2_phi         ! azimuthal angle of track in degrees 
+      Real*4      trk2_eta         ! pseudorapidity of track
+
+CCC   END common/track2/
diff --git a/HBTP/dummyhbtproc.f b/HBTP/dummyhbtproc.f
new file mode 100644 (file)
index 0000000..381a2c6
--- /dev/null
@@ -0,0 +1,49 @@
+      subroutine dd()
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_coulomb.inc'
+      Include 'common_event_summary.inc'
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+      Include 'common_particle.inc'
+
+      end  
+
+C      subroutine parameters()
+C      end  
+C      subroutine mesh()
+C      end  
+      
+C      subroutine track1()
+C      end  
+      
+C      subroutine track2()
+C      end  
+      
+C      subroutine sec_trk_map()
+C      end  
+      
+C      subroutine sec_trk_map2()
+C      end  
+      
+C      subroutine particle()
+C      end  
+      
+C      subroutine correlations()
+C      end  
+      
+C      subroutine coulmb()
+C      end  
+C      subroutine event_summary()
+C      end
+      
+C      subroutine  histograms()
+C      end
diff --git a/HBTP/hbt_event_processor.f b/HBTP/hbt_event_processor.f
new file mode 100644 (file)
index 0000000..258e1ea
--- /dev/null
@@ -0,0 +1,7391 @@
+CCC ********************************************************************
+CCC  Modifications for ALICE-ROOT application at CERN - 12/15/2000
+CCC  1.  Removed all Fortran Data Structures in favor of labelled
+CCC      common blocks.  The syntax of the structure_variable to
+CCC      common variable name change is:
+CCC      In STAR code    In ALICE code
+CCC        A(i).B     ==>  A_B(i)
+CCC        A(i).B(j)  ==>  A_B(j,i)
+CCC  2.  All remaining references in the comments and write statements
+CCC      to the data structures are interpreted as applying to the
+CCC      new common variables.
+CCC  3.  The UNIX random number generator, ran(), was replaced with
+CCC      a function which calls a modified version of the CERNLIB
+CCC      random number generator, ranlux, herein called ranlux2.  The
+CCC      latter allows a user supplied seed value.
+CCC  4.  Increased the following array sizes for the LHC Pb+Pb design
+CCC      multiplicity criteria of dN_{ch}/dy = 8000 assuming 80% of
+CCC      this is pi(+) and pi(-), which are the largest populations
+CCC      that this code is required to process.
+CCC
+CCC      The following are for the max number of tracks that can be
+CCC      stored in each sector without overflow:
+CCC         common_mesh.inc - increased max_trk_save from 30 to 150
+CCC         common_sec_track.inc  - inc. max_trk_sec from 30 to 150
+CCC         common_sec_track2.inc - inc. max_trk_sec2 from 30 to 150
+CCC
+CCC      The following determine the maximum number of tracks that can
+CCC      be processed in an event:
+CCC         common_track.inc - increased trk_maxlen from 6500 to 25000
+CCC         common_track2.inc - increased trk2_maxlen from 6500 to 25000
+CCC
+C
+C     DESCRIPTION OF METHOD:
+C     =====================
+C
+C          This program produces relativistic heavy-ion collision
+C     events in which the particle momenta for selected particle ID
+C     types and for selected kinematic acceptance ranges are randomly
+C     adjusted such that specified one-body distributions and two-body
+C     correlation functions are reproduced.  The input to the code may
+C     be a set of events from any STAR event generator, so long as the
+C     format is in the STAR Geant (GSTAR) text format standard (see
+C     STAR Note #235).  The basic method is similar to that of Metropolis
+C     et al. and is fully described in Ray and Hoffmann, Phys. Rev. C 54,
+C     2582 (1996).  Briefly the steps in the algorithm include:
+C
+C        (1) For an initial particle distribution of specified particle
+C            ID types (maximum of two types allowed) and momentum
+C            acceptance ranges [given in terms of transverse momentum 
+C            (p_T), azimuthal angle (phi) and pseudorapidity (eta)] the
+C            momentum vector of one particle is randomly shifted within
+C            a specified range from its initial value.  The shifts are
+C            done for px, py and pz independently.
+C
+C        (2) New one-body and two-body histograms, as well as the two-body
+C            correlation function are calculated.
+C
+C        (3) If the random momentum shift results in an improved overall
+C            chi-square, obtained by comparison with a specified reference 
+C            for the one-body distribution and the two-body correlation
+C            model, then the new momentum vector is retained.  If not,
+C            then the vector is restored to its starting value.
+C
+C        (4) Steps 1-3 are repeated for each accepted particle in the
+C            event.
+C
+C        (5) The entire process, steps 1-4, is repeated until either a
+C            satisfactory fit to the model distributions are obtained or 
+C            the maximum number of iterations is reached.
+C
+C        (6) Once the iterative process is complete, the input event file
+C            is copied directly to an output event file where the adjusted
+C            momentum values for the accepted tracks replace that in the
+C            input file.  The event output file is in the GSTAR standard
+C            text format.  This event output file may be processed again
+C            by this code in order to generate correlations for other 
+C            particle types or for different kinematic ranges.  The file
+C            is suitable for input into the STAR version of Geant-3, called
+C            GSTAR (STAR Note 235).
+C
+C     In order to reduce cpu demand the particle momenta are sorted into
+C     momentum space cells or sectors.  In forming particle pairs only those
+C     particles in the same, or adjacent cells are used.  For large events
+C     this vastly reduces the required cpu time.  The penalty is that the
+C     coding becomes more complicated.  Much of the present code is devoted
+C     to the necessary bookeeping chores that must be done in order to
+C     determine which cell the tracks are in and if they move to new cells
+C     during the track adjustment procedure.  Information about the 
+C     momentum space cells are contained in the data structure /sec_trk_map/.
+C
+C     The sector size must therefore be scaled with the specified correlation
+C     range.  All particles will be paired with all possible partners out
+C     to Q's equal to the smallest dimension of the momentum space sectors.
+C     Particle pairs with Q greater than this sector dimension will suffer
+C     reduced acceptance, finally being completely cut-off for Q ~> 2 times
+C     the diagonal length thru a sector. 
+C
+C          In order to generate momentum correlations for particle types
+C     having low multiplicity it is necessary for the user to supply this
+C     code with an artificially enhanced multiplicity along with a track-
+C     write-output fractional acceptance factor (see input variable
+C     'trk_accep').  For example, if the user wants to generate HBT
+C     correlations for K0-shorts but the assumed multiplicity is too
+C     low for the present algorithm to work, the user may increase the
+C     input K0-short multiplicity, for instance by a factor of 5, then
+C     run the code and set trk_accep = 1/5 = 0.2 in order to randomly
+C     reject about 80% of the K0-shorts.  The track rejection is done
+C     after the track adjustment procedure is completed.  This procedure
+C     should preserve the built-in correlations in the final output
+C     event file, although with reduced statistics.
+C          Another approach for handling low multiplicity events would
+C     be to combine particles from several events, carry out the track
+C     adjustment procedure, then separate the tracks into their original
+C     events.  This method must insure that no bias is included due to
+C     the order of processing the tracks from the first, second, etc.
+C     events.  This latter method, once proven, could be used for
+C     the low multiplicity particles from any event generator.  For
+C     the present version of the code the low multiplicity HBT studies
+C     must utilize a Monte Carlo multiplicity generator.
+C
+C          The code may also be used to read in a previously correlated 
+C     set of events and either compute the reference histograms or read in
+C     the references, and then compute the correlations for each event and
+C     the inclusive correlations without doing the track momentum adjustment
+C     procedure.  This feature may be used, for example, to study the 
+C     correlations that result in one set of coordinates for events fitted
+C     to correlations with respect to a different set of coordinates.  For
+C     example, fit the correlations to the Y-K-P form and then evaluate
+C     the side-out-long correlations, or vice-versa.
+C 
+C     TWO-BODY REFERENCE HISTOGRAMS:
+C     =============================
+C
+C          In order to calculate the correlations, an uncorrelated two-body
+C     reference spectrum is needed.  The program will calculate this
+C     quantity by forming pairs of particles from different events in the
+C     input file.  For the particle ID type(s) and momentum acceptance
+C     the code forms all possible pairs (given the cell substructure) by 
+C     mixing particles from event#1 with those in event#2, then particles
+C     from event#2 are mixed with particles from event#3, then events 3
+C     and 4 are mixed, and so on.  In this way ample statistics may be
+C     achieved for the reference distributions.  These reference distributions
+C     can be written out to file and re-used in subsequent runs.  Since
+C     all events in the input event file are used in generating the 
+C     reference distribution, it is imperative that these events be physically
+C     similar.
+C
+C     ONE-BODY REFERENCE HISTOGRAMS:
+C     =============================
+C
+C          Inclusive sums of the accepted particles for all events in the
+C     input event file determine the one-body reference distributions.
+C     These are used to constrain the momentum vector shifts.  Although
+C     the one-body distributions from realistic event generators are fully
+C     three-dimensional, the present code is restricted to only work with
+C     the one-dimensional projections onto p_T, phi and eta.  In other words,
+C     the p_T distribution used in this code is formed by integrating 
+C     the particle distributions over (phi,eta) over the momentum acceptance
+C     range.  No particle distribution models are built into the code.
+C     The one-body reference distributions are either read-in or determined
+C     from the events in the input event text file.
+C
+C     TWO-BODY CORRELATION MODELS:
+C     ===========================
+C
+C          The code permits both 1-dimensional and 3-dimensional two-body
+C     correlation models.  These may be fitted separately or simultaneously.
+C     The source may include a mixture of incoherent and coherent components;
+C     Coulomb corrections are also included.  The general form assumed 
+C     [see Cramer and Kadija, Phys. Rev. C 53, 908 (1996)] is:
+C
+C       C2 = 1 + lambda*(b**2) + 2.0*sqrt(lambda)*[1 - sqrt(lambda)]*b 
+C
+C     where lambda is the usual chaoticity parameter.  The third term in
+C     this equation may be turned on or off.  Values of lambda < 1.0 may
+C     be used without the third term being included.  For 1-dimensional
+C     functions b is given by:
+C
+C       b = exp(- Q**2 * R**2 / 2)
+C
+C     where Q is either the invariant 4-momentum difference, the total
+C     4-momentum difference (i.e. time-like + space-like) or the
+C     3-vector momentum difference.  The 3-dimensional functions may be
+C     of the Bertsch-Pratt ``side-out-longitudinal'' form given by:
+C
+C       b = exp[(- Qside**2 * Rside**2 - Qout**2 * Rout**2
+C                - Qlong**2 * Rlong**2)/2]
+C
+C     where the ``out-long'' cross term is omitted.  The 3D function may 
+C     also be in the Yano-Koonin-Podgoretski (YKP) form given by (for
+C     pairs in the A+A c.m. frame):
+C
+C       b = exp[(- Qperp**2 * Rperp**2 - Qparallel**2 * Rparallel**2
+C                - Qtime**2 * Rtime**2)/2]
+C
+C     where
+C                Qperp = transverse momentum difference
+C                Qparallel = Qlong = p_{1z} - p_{2z}
+C                Qtime = E_1 - E_2
+C
+C     The Coulomb correction may be omitted, or included in one of 3 ways:
+C
+C          (1) Point source Gamow factor
+C          (2) Finite source NA35 model (see Eq.(5) in Z. Phys. C73, 443
+C              (1997)) where
+C              
+C              Coulomb correction = 1 + [G(q) - 1]*exp(-q/Q0) 
+C
+C              and G(q) is the Gamow factor and q is the 3-momentum
+C              vector difference.
+C          (3) Finite source, Pratt integrated Coulomb wave function
+C              integrals, interpolated for a specific source radius
+C              from John Cramer's tables for discrete source radii.
+C
+C     These Coulomb correction factors multiply the above correlation
+C     function to give the total correlation function to be fitted for
+C     charged, like pairs. For charged, unlike pairs only the Coulomb
+C     (attractive) correlation function is used.
+C
+C     BINNING:
+C     =======
+C
+C          Several types of binning are done in the code. The one-body
+C     distributions are binned in p_t, phi and eta.  The full momentum
+C     space is subdivided into cells or sectors.  The 1D and 3D two-body
+C     distributions are binned into fine and coarse bins, where the fine
+C     bins occur at the smaller momentum difference range and the coarse
+C     bins at the larger.  For the 3D distributions the (1,1,1) coarse
+C     bin must coincide with the 3D fine bins.
+C
+C     SUMMARY OF EXTERNAL FILES:
+C     =========================
+C
+C File Unit#    File Name                Description
+C ----------------------------------------------------------------------------
+C     1      hbt_parameters.in          Input switches and controls
+C     2      event_text.in              Event generator output in GSTAR text
+C     3      event_line.flags           Generated tmp file, input line flags
+C     4      event_tracks.select        Generated tmp file, accep. tracks flg.
+C     7      hbt_log.out                Generated log file - error reports
+C     8      hbt_simulation.out         Generated main output file
+C     9      hbt_pair_reference.hist    Generated pair ref. histograms
+C     10     event_hbt_text.out         Gen. correlated event text file
+C     11     hbt_singles_reference.hist Gen. one-body ref. histograms
+C     12     event_text_aux.in          Tmp copy of event_text.in per event
+C     14     event_tracks_aux.select    Tmp copy of event_tracks.select/event
+C     21-27  cpp_*.dat (*=06,08...18)   Like pair Pratt Coulomb corrections.
+C     31-37  cpm_*.dat (*=06,08...18)   Unlike pair Pratt Coulomb corrects.
+C ----------------------------------------------------------------------------
+C
+C     Source of Data for ALICE Application:
+C     ====================================
+C
+C File Unit#    File Name                For ALICE File or Struc?
+C ----------------------------------------------------------------------------
+C     1      hbt_parameters.in          Call AliHbtp_ function
+C     2      event_text.in              Call AliHbtp_ function
+C     3      event_line.flags           File not used
+C     4      event_tracks.select        File not used
+C     7      hbt_log.out                File used as is
+C     8      hbt_simulation.out         File used as is
+C     9      hbt_pair_reference.hist    File used as is
+C     10     event_hbt_text.out         Call AliHbtp_ function
+C     11     hbt_singles_reference.hist File used as is
+C     12     event_text_aux.in          File not used
+C     14     event_tracks_aux.select    File not used
+C     21-27  cpp_*.dat (*=06,08...18)   Files are used as is
+C     31-37  cpm_*.dat (*=06,08...18)   Files are used as is
+C ----------------------------------------------------------------------------
+C
+C     DESCRIPTION OF INPUT PARAMETERS AND SWITCHES (FILE: hbt_parameters.in):
+C     ======================================================================
+C
+C     Control Switches:
+C     ================
+C
+C        ref_control       = 1 to read reference histograms from input files
+C                          = 2 to compute reference histograms by track 
+C                              mixing from event pairs in the event input file.
+C
+C        switch_1d         = 0 to not compute the 1D two-body correlations.
+C                          = 1 to compute this using Q-invariant
+C                          = 2 to compute this using Q-total
+C                          = 3 to compute this using Q-3-vector
+C
+C        switch_3d         = 0 to not compute the 3D two-body correlations.
+C                          = 1 to compute this using the side-out-long form
+C                          = 2 to compute this using the YKP form.
+C
+C        switch_type       = 1 to fit only the like pair correlations
+C                          = 2 to fit only the unlike pair correlations
+C                          = 3 to fit both the like and unlike pair correl.
+C
+C        switch_coherence  = 0 for purely incoherent source (but can have
+C                              lambda < 1.0)
+C                          = 1 for mixed incoherent and coherent source
+C
+C        switch_coulomb    = 0 no Coulomb correction
+C                          = 1 Point source Gamow correction only
+C                          = 2 NA35 finite source size correction
+C                          = 3 Pratt/Cramer finite source size correction;
+C                              interpolated from input tables.
+C
+C        switch_fermi_bose =  1 Boson pairs
+C                          = -1 Fermion pairs
+C
+C        trk_accep         = 1.0 all adjusted tracks are written out
+C                          < 1.0 only this fraction, on average, of the
+C                            adjusted tracks are written out.  Used for
+C                            low multiplicity events.
+C
+C        print_full        = 0 for standard, minimal output
+C                          = 1 for full, comprehensive (large) output for
+C                              each event.
+C
+C        print_sector_data = 0 std. sector occupancy data printed out
+C                          = 1 to print sector occupancy and overflow info.
+C
+C     Particle ID and Search Parameters:
+C     =================================
+C
+C        n_pid_types       = 1 or 2 only, # particle types to correlate
+C 
+C        pid(1), pid(2)    = Geant-3 particle ID code numbers
+C
+C        deltap            = maximum range for random momentum shifts in
+C                            GeV/c; px,py,pz independent; Def = 0.1 GeV/c.
+C
+C        maxit             = maximum # allowed iterations thru all the
+C                            tracks for each event. Default = 50.
+C                            If maxit=0, then calculate the correlations 
+C                            for the input set of events without doing the
+C                            track adjustment procedure.
+C
+C        delchi            = min % change in total chi-square for which
+C                            the track adjustment iterations may stop,
+C                            Default = 0.1%.
+C
+C        irand             = initial random # seed, default = 12345
+C
+C     Source Function Parameters:
+C     ==========================
+C
+C        lambda            = Chaoticity
+C
+C        R_1d              = Spherical source model radius (fm)
+C
+C        Rside,Rout,Rlong  = Non-spherical Bertsch-Pratt source model (fm)
+C
+C        Rperp,Rparallel,R0= Non-spherical Yano-Koonin-Podgoretski source
+C                            model (fm).
+C
+C        Q0                = NA35 Coulomb parameter for finite source size
+C                            in (GeV/c) - iff switch_coulomb = 2
+C                          = Spherical Coulomb source radius in (fm) iff
+C                            switch_coulomb = 3, used to interpolate the
+C                            input Pratt/Cramer discrete Coulomb source
+C                            radii tables.
+C
+C     One-body pT, phi, eta Acceptance Bins:
+C     =====================================
+C
+C        n_pt_bins, pt_min, pt_max  = # pt bins,  min/max pt accept. (GeV/c)
+C
+C        n_phi_bins,phi_min,phi_max = # phi bins, min/max phi accept. (deg.)
+C
+C        n_eta_bins,eta_min,eta_max = # eta bins, min/max eta accept. 
+C
+C                                     [NOTE: For each the maximum # of bins
+C                                            must be .le. 100]
+C
+C     Two-body 1D and 3D Correlation Bins:
+C     ===================================
+C
+C        n_1d_fine,  binsize_1d_fine   = # and size (GeV/c), 1D - fine mesh
+C
+C        n_1d_coarse,binsize_1d_coarse = # and size (GeV/c), 1D - coarse mesh
+C
+C        n_3d_fine,  binsize_3d_fine   = # and size (GeV/c), 3D - fine mesh
+C
+C        n_3d_coarse,binsize_3d_coarse = # and size (GeV/c), 3D - coarse mesh
+C
+C                                      [NOTE: The maximum # of 1D bins (fine
+C                                             + coarse) must be .le. 100;
+C                                             The maximum # of 3D bins (either
+C                                             fine or coarse) must be .le.10).
+C                                             For both 1D and 3D there must be
+C                                             at least 1 fine bin and 1 coarse
+C                                             bin.]
+C        n_3d_fine_project             = # of 3D-fine bins to integrate over
+C                                        to form 1D projections.  This value
+C                                        must be .le. n_3d_fine.
+C
+C     Momentum Space Track-Sector Cells:
+C     =================================
+C
+C        n_px_bins,px_min,px_max = #, min,max px bins (GeV/c)
+C
+C        n_py_bins,py_min,py_max = #, min,max py bins (GeV/c)
+C
+C        n_pz_bins,pz_min,pz_max = #, min,max pz bins (GeV/c)
+C
+C                                  [NOTE: The maximum number of total sectors,
+C                                         equal to the product of the x-y-z
+C                                         number of cells must be .le.
+C                                         sec_maxlen which is defined in the
+C                                         /sec_trk_map/ data structure.]
+C
+C     Relative Chi-Square Weights:
+C     ===========================
+C
+C        chisq_wt_like_1d          = 1D, like pairs
+C        chisq_wt_unlike_1d        = 1D, unlike pairs
+C        chisq_wt_like_3d_fine     = 3D, like pairs, fine mesh
+C        chisq_wt_unlike_3d_fine   = 3D, unlike pairs, fine mesh
+C        chisq_wt_like_3d_coarse   = 3D, like pairs, coarse mesh
+C        chisq_wt_unlike_3d_coarse = 3D, unlike pairs, coarse mesh
+C        chisq_wt_hist1_1 = summed pt, phi, eta 1-body dist., PID#1
+C        chisq_wt_hist1_2 = summed pt, phi, eta 1-body dist., PID#2
+C
+C
+C     FORMAT for hbt_singles_reference.hist:
+C     =====================================
+C
+C     The output content for the one-body reference histograms is:
+C
+C     Line 1:  n_pid_types,pid(1),pid(2)
+C          2:  n_pt_bins,pt_min,pt_max
+C          3:  n_phi_bins,phi_min,phi_max
+C          4:  n_eta_bins,eta_min,eta_max
+C          5:  n_part_used_1_ref,n_part_used_2_ref
+C
+C     Then for PID #1:      (href1_pt_1(i),i=1,n_pt_bins)
+C     (One entry per line)  (href1_phi_1(i),i=1,n_phi_bins)
+C                           (href1_eta_1(i),i=1,n_eta_bins)
+C
+C     and for PID #2:       (href1_pt_2(i),i=1,n_pt_bins)
+C     (One entry per line)  (href1_phi_2(i),i=1,n_phi_bins)
+C                           (href1_eta_2(i),i=1,n_eta_bins)
+C
+C
+C     FORMAT for hbt_pair_reference.hist:
+C     ==================================
+C
+C     The output content for the two-body reference histograms is:
+C
+C     Line 1:  n_pid_types,pid(1),pid(2)
+C          2:  n_pt_bins,pt_min,pt_max
+C          3:  n_phi_bins,phi_min,phi_max
+C          4:  n_eta_bins,eta_min,eta_max
+C          5:  switch_1d,switch_3d,switch_type
+C          6:  n_1d_fine,n_1d_coarse,n_3d_fine,n_3d_coarse
+C          7:  binsize_1d_fine,binsize_1d_coarse,
+C              binsize_3d_fine,binsize_3d_coarse
+C          8:  num_pairs_like_ref,num_pairs_unlike_ref
+C
+C   The pair distributions (with one entry per line) are:
+C
+C   1D, like pairs:             (href_like_1d(i),i=1,n_1d_total)
+C
+C   1D, unlike pairs:           (href_unlike_1d(i),i=1,n_1d_total)
+C
+C   3D, like pairs, fine mesh:   href_like_3d_fine(i,j,k) ; (i,(j,(k,...)))
+C
+C   3D, like pairs, coarse mesh: href_like_3d_coarse(i,j,k) ; (i,(j,(k,...)))
+C
+C   3D, unlike, fine mesh:       href_unlike_3d_fine(i,j,k) ; (i,(j,(k,...)))
+C
+C   3D, unlike, coarse mesh:     href_unlike_3d_coarse(i,j,k) ; (i,(j,(k,...)))
+C
+C*************************************************************************
+C*************************************************************************
+
+      SUBROUTINE CTEST
+      implicit none
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_coulomb.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+      Include 'common_particle.inc'
+      
+      write(*,*) ' '
+      write(*,*) ' '
+      write(*,*) ' '
+      
+      write(*,*) 'Input data in Fort'
+      write(*,*) ' '
+      write(*,*) ' '
+      write(*,*) ' '
+      write(*,*) '      PARAMETERS'
+      write(*,*) ' '
+      write(*,*) 'ref_control',ref_control
+      write(*,*) 'switch_1d',switch_1d 
+      write(*,*) 'switch_3d',switch_3d
+      write(*,*) 'switch_type',switch_type
+      write(*,*) 'switch_coherence',switch_coherence
+      write(*,*) 'switch_coulomb',switch_coulomb
+      write(*,*) 'switch_fermi_bose',switch_fermi_bose
+      write(*,*) 'trk_accep',trk_accep
+      write(*,*) 'print_full',print_full
+      write(*,*) 'print_sector_data',print_sector_data
+      write(*,*) 'n_pid_types',n_pid_types
+      write(*,*) 'pid(1)', pid(1)
+      write(*,*) 'pid(2)', pid(2)
+      write(*,*) 'maxit',maxit
+      write(*,*) 'irand',irand
+      write(*,*) 'n_part_1_trk', n_part_1_trk      
+      write(*,*) 'n_part_2_trk ', n_part_2_trk      
+      write(*,*) 'n_part_tot_trk ', n_part_tot_trk      
+      write(*,*) 'n_part_used_1_trk ', n_part_used_1_trk      
+      write(*,*) 'n_part_used_2_trk',  n_part_used_2_trk     
+      write(*,*) 'n_part_1_trk2',    n_part_1_trk2   
+      write(*,*) 'n_part_2_trk2', n_part_2_trk2      
+      write(*,*) 'n_part_tot_trk2',   n_part_tot_trk2    
+      write(*,*) 'n_part_used_1_trk2',  n_part_used_1_trk2     
+      write(*,*) 'n_part_used_2_trk2',  n_part_used_2_trk2     
+      write(*,*) 'n_part_used_1_ref', n_part_used_1_ref      
+      write(*,*) 'n_part_used_2_ref ',  n_part_used_2_ref     
+      write(*,*) 'n_part_used_1_inc',  n_part_used_1_inc     
+      write(*,*) 'n_part_used_2_inc',     n_part_used_2_inc  
+      write(*,*) 'num_pairs_like',   num_pairs_like    
+      write(*,*) 'num_pairs_unlike',  num_pairs_unlike     
+      write(*,*) 'num_pairs_like_ref ', num_pairs_like_ref      
+      write(*,*) 'num_pairs_like_inc ',  num_pairs_like_inc     
+      write(*,*) 'num_pairs_unlike_inc', num_pairs_unlike_inc      
+      write(*,*) 'event_line_counter', event_line_counter      
+      write(*,*) 'file10_line_counter ',file10_line_counter       
+      write(*,*) 'lambda',lambda
+      write(*,*) 'R_1d ',R_1d 
+      write(*,*) 'Rside',Rside
+      write(*,*) 'Rout  ',  Rout
+      write(*,*) 'Rlong  ', Rlong 
+      write(*,*) 'Rperp  ',  Rperp
+      write(*,*) 'Rparallel  ', Rparallel 
+      write(*,*) 'R0 ',  R0
+      write(*,*) 'Q0 ',  Q0
+      write(*,*) 'deltap',deltap
+      write(*,*) 'delchi',delchi
+      write(*,*) 'pi ', pi 
+      write(*,*) 'rad ', rad 
+      write(*,*) 'hbc ', hbc 
+      write(*,*) 'chisq_wt_like_1d ', chisq_wt_like_1d 
+      write(*,*) 'chisq_wt_unlike_1d ',  chisq_wt_unlike_1d
+      write(*,*) 'chisq_wt_like_3d_fine  ',chisq_wt_like_3d_fine  
+      write(*,*) 'chisq_wt_unlike_3d_fine ',  chisq_wt_unlike_3d_fine
+      write(*,*) 'chisq_wt_like_3d_coarse ', chisq_wt_like_3d_coarse
+      write(*,*) 'chisq_wt_unlike_3d_coarse',chisq_wt_unlike_3d_coarse 
+      write(*,*) 'chisq_wt_hist1_1 ', chisq_wt_hist1_1 
+      write(*,*) 'chisq_wt_hist1_2 ', chisq_wt_hist1_2 
+      write(*,*) ' '
+      write(*,*) ' '
+      write(*,*) ' '
+      write(*,*) '         MESH       '  
+      write(*,*) ' '
+      write(*,*) ' n_pt_bins ',  n_pt_bins
+      write(*,*) ' pt_min ', pt_min 
+      write(*,*) ' pt_max  ', pt_max  
+      write(*,*) ' n_phi_bins ', n_phi_bins 
+      write(*,*) ' phi_min ', phi_min 
+      write(*,*) ' phi_max ', phi_max 
+      write(*,*) ' n_eta_bins ', n_eta_bins 
+      write(*,*) ' eta_min', eta_min 
+      write(*,*) ' eta_max', eta_max 
+      write(*,*) ' n_1d_fine ', n_1d_fine 
+      write(*,*) ' binsize_1d_fine ',binsize_1d_fine  
+      write(*,*) ' n_1d_coarse ',n_1d_coarse  
+      write(*,*) ' binsize_1d_coarse ', binsize_1d_coarse 
+      write(*,*) ' n_3d_fine  ',n_3d_fine   
+      write(*,*) ' binsize_3d_fine ',binsize_3d_fine  
+      write(*,*) ' n_3d_coarse ', n_3d_coarse 
+      write(*,*) ' binsize_3d_coarse ', binsize_3d_coarse 
+      write(*,*) ' n_3d_fine_project ',n_3d_fine_project  
+      write(*,*) ' n_px_bins ',n_px_bins  
+      write(*,*) ' px_min ',px_min  
+      write(*,*) ' px_max ', px_max 
+      write(*,*) ' n_py_bins ', n_py_bins 
+      write(*,*) ' py_min ',  py_min
+      write(*,*) ' py_max',  py_max
+      write(*,*) ' n_pz_bins ',n_pz_bins  
+      write(*,*) ' pz_min ', pz_min 
+      write(*,*) ' pz_max ', pz_max 
+      write(*,*) '  '
+   
+      End
+
+
+
+      SUBROUTINE HBTPROCESSOR
+      implicit none
+
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_coulomb.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+      Include 'common_particle.inc'
+
+CCC   Set Data I/O control for ALICE or Standalone application
+C     ALICE = 1   ! This is for the ALICE AliRoot application
+CCC   ALICE = 0   ! This is for the standalone application
+
+CCC   Initialize error code for ALICE application:
+      errorcode = 0
+
+CCC   Open Output Files:
+
+      open(unit=7,status='unknown',access='sequential',
+     1     name='hbt_log.out')
+      open(unit=8,status='unknown',access='sequential',
+     1     name='hbt_simulation.out')
+
+CCC   Initialize Arrays and Data Structures:
+      If(ALICE .eq. 1) then
+C     In fact we not need to call initialization, 
+C     because we can easily assume that is already done
+         Call alihbtp_initialize
+      Else If (ALICE .eq. 0) Then
+         Call initialize
+      End If
+
+      Write(6,100)
+CCC   Read Input Controls and Parameters:
+      Call read_data(1)
+      If(errorcode .eq. 1) Return
+      
+CCC   Setup values and check input parameter ranges and consistency:
+      Call set_values
+      If(errorcode .eq. 1) Return
+
+CCC   Produce Basic Output File Header:
+      Call write_data(1,0)
+      If(errorcode .eq. 1) Return
+      
+      
+      Write(6,101)
+CCC   Read Event Input file and fill flag files:
+      Call read_data(2)
+      If(errorcode .eq. 1) Return
+      
+      Write(6,102)
+CCC   Get the Reference Histograms and write out if new calculation:
+      Call getref_hist
+      If(errorcode .eq. 1) Return
+      Call write_data(3,0)
+      If(errorcode .eq. 1) Return
+      Write(6,103)
+
+      Write(6,104)
+CCC   Compute the correlation model and print out:
+      Call correl_model
+      Call write_data(4,0)
+      If(errorcode .eq. 1) Return
+
+      Write(6,105)
+CCC   Carry out the Track Adjustment/Correlation Fitting Procedure:
+      Call correlation_fit
+      Write(6,106)
+
+CCC   Final Output of Inclusive Quantities:
+      Call write_data(6,0)
+      If(errorcode .eq. 1) Return
+      
+CCC   Close Output Files:
+      close(unit=7)
+      close(unit=8)
+
+CCC   Formats:
+100   Format(5x,'Read Input Controls, Setup values, check input:')
+101   Format(5x,'Read Event Input file and fill flag files:')
+102   Format(5x,'Get the Reference Histograms:')
+103   Format(5x,'Finished with Reference Histograms:')
+104   Format(5x,'Compute the correlation model:')
+105   Format(5x,'Start Track Adjustment/Correlation Fitting Procedure:')
+106   Format(5x,'Finished with Track Fitting Procedure:')
+
+      Return
+      END
+
+C-------------------------------------------------------------------
+
+
+      subroutine initialize
+      implicit none
+
+CCC   This subroutine sets all arrays and structures to zero:
+
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_coulomb.inc'
+      Include 'common_event_summary.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+      Include 'common_particle.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,j,k
+
+      do i = 1,trk_maxlen
+         trk_id(i)            = 0
+         trk_px_sec(i)        = 0
+         trk_py_sec(i)        = 0
+         trk_pz_sec(i)        = 0
+         trk_sector(i)        = 0
+         trk_flag(i)          = 0
+         trk_out_flag(i)      = 0
+         trk_merge_flag(i)    = 0
+         trk_ge_pid(i)        = 0
+         trk_start_vertex(i)  = 0
+         trk_stop_vertex(i)   = 0
+         trk_event_line(i)    = 0
+         trk_px(i)            = 0.0
+         trk_py(i)            = 0.0
+         trk_pz(i)            = 0.0
+         trk_E(i)             = 0.0
+         trk_pt(i)            = 0.0
+         trk_phi(i)           = 0.0
+         trk_eta(i)           = 0.0
+      end do
+      
+      do i = 1,trk2_maxlen
+         trk2_id(i)            = 0
+         trk2_px_sec(i)        = 0
+         trk2_py_sec(i)        = 0
+         trk2_pz_sec(i)        = 0
+         trk2_sector(i)        = 0
+         trk2_flag(i)          = 0
+         trk2_out_flag(i)      = 0
+         trk2_merge_flag(i)    = 0
+         trk2_ge_pid(i)        = 0
+         trk2_start_vertex(i)  = 0
+         trk2_stop_vertex(i)   = 0
+         trk2_event_line(i)    = 0
+         trk2_px(i)            = 0.0
+         trk2_py(i)            = 0.0
+         trk2_pz(i)            = 0.0
+         trk2_E(i)             = 0.0
+         trk2_pt(i)            = 0.0
+         trk2_phi(i)           = 0.0
+         trk2_eta(i)           = 0.0
+      end do
+
+      do i = 1,sec_maxlen
+         stm_sec_id(i)         = 0
+         stm_n_trk_sec(i)      = 0
+         stm_flag(i)           = 0
+         do j = 1,max_trk_sec
+            stm_track_id(j,i)  = 0
+         end do
+      end do
+
+      do i = 1,sec_maxlen2
+         stm2_sec_id(i)         = 0
+         stm2_n_trk_sec(i)      = 0
+         stm2_flag(i)           = 0
+         do j = 1,max_trk_sec2
+            stm2_track_id(j,i)  = 0
+         end do
+      end do
+
+      do i = 1,part_maxlen
+         part_id(i)       = 0
+         part_charge(i)   = 0
+         part_mass(i)     = 0.0
+         part_lifetime(i) = 0.0
+      end do
+
+      do i = 1,max_trk_save
+         old_sec_trkid(i) = 0
+         new_sec_trkid(i) = 0
+      end do
+
+      do i = 1,max_h_1d
+         hist_like_1d(i)   = 0
+         hist_unlike_1d(i) = 0
+         htmp_like_1d(i)   = 0
+         htmp_unlike_1d(i) = 0
+         href_like_1d(i)   = 0
+         href_unlike_1d(i) = 0
+         hinc_like_1d(i)   = 0
+         hinc_unlike_1d(i) = 0
+         hist1_pt_1(i)     = 0
+         hist1_pt_2(i)     = 0
+         hist1_phi_1(i)    = 0
+         hist1_phi_2(i)    = 0
+         hist1_eta_1(i)    = 0
+         hist1_eta_2(i)    = 0
+         htmp1_pt_1(i)     = 0
+         htmp1_pt_2(i)     = 0
+         htmp1_phi_1(i)    = 0
+         htmp1_phi_2(i)    = 0
+         htmp1_eta_1(i)    = 0
+         htmp1_eta_2(i)    = 0
+         href1_pt_1(i)     = 0
+         href1_pt_2(i)     = 0
+         href1_phi_1(i)    = 0
+         href1_phi_2(i)    = 0
+         href1_eta_1(i)    = 0
+         href1_eta_2(i)    = 0
+         hinc1_pt_1(i)     = 0
+         hinc1_pt_2(i)     = 0
+         hinc1_phi_1(i)    = 0
+         hinc1_phi_2(i)    = 0
+         hinc1_eta_1(i)    = 0
+         hinc1_eta_2(i)    = 0
+      end do
+
+      do i = 1,max_h_3d
+      do j = 1,max_h_3d
+      do k = 1,max_h_3d
+         hist_like_3d_fine(i,j,k)     = 0
+         hist_unlike_3d_fine(i,j,k)   = 0
+         hist_like_3d_coarse(i,j,k)   = 0
+         hist_unlike_3d_coarse(i,j,k) = 0
+         htmp_like_3d_fine(i,j,k)     = 0
+         htmp_unlike_3d_fine(i,j,k)   = 0
+         htmp_like_3d_coarse(i,j,k)   = 0
+         htmp_unlike_3d_coarse(i,j,k) = 0
+         href_like_3d_fine(i,j,k)     = 0
+         href_unlike_3d_fine(i,j,k)   = 0
+         href_like_3d_coarse(i,j,k)   = 0
+         href_unlike_3d_coarse(i,j,k) = 0
+         hinc_like_3d_fine(i,j,k)     = 0
+         hinc_unlike_3d_fine(i,j,k)   = 0
+         hinc_like_3d_coarse(i,j,k)   = 0
+         hinc_unlike_3d_coarse(i,j,k) = 0
+      end do
+      end do
+      end do 
+
+      do i = 1,max_c2_1d
+         c2mod_like_1d(i)   = 0.0
+         c2mod_unlike_1d(i) = 0.0
+         c2fit_like_1d(i)   = 0.0
+         c2fit_unlike_1d(i) = 0.0
+         c2err_like_1d(i)   = 0.0
+         c2err_unlike_1d(i) = 0.0
+      end do
+
+      do i = 1,max_c2_3d
+      do j = 1,max_c2_3d
+      do k = 1,max_c2_3d
+         c2mod_like_3d_fine(i,j,k)     = 0.0
+         c2mod_unlike_3d_fine(i,j,k)   = 0.0
+         c2mod_like_3d_coarse(i,j,k)   = 0.0
+         c2mod_unlike_3d_coarse(i,j,k) = 0.0
+         c2fit_like_3d_fine(i,j,k)     = 0.0
+         c2fit_unlike_3d_fine(i,j,k)   = 0.0
+         c2fit_like_3d_coarse(i,j,k)   = 0.0
+         c2fit_unlike_3d_coarse(i,j,k) = 0.0
+         c2err_like_3d_fine(i,j,k)     = 0.0
+         c2err_unlike_3d_fine(i,j,k)   = 0.0
+         c2err_like_3d_coarse(i,j,k)   = 0.0
+         c2err_unlike_3d_coarse(i,j,k) = 0.0
+      end do
+      end do
+      end do
+
+      do i = 1,max_c2_coul
+         c2_coul_like(i)   = 0.0
+         c2_coul_unlike(i) = 0.0
+         q_coul(i)         = 0.0
+      end do
+
+      do i = 1,max_events
+         num_iter(i)                      = 0.0
+         n_part_used_1_store(i)           = 0.0
+         n_part_used_2_store(i)           = 0.0
+         num_sec_flagged_store(i)         = 0.0
+         frac_trks_out(i)                 = 0.0
+         frac_trks_flag(i)                = 0.0
+         chisq_like_1d_store(i)           = 0.0
+         chisq_unlike_1d_store(i)         = 0.0
+         chisq_like_3d_fine_store(i)      = 0.0
+         chisq_unlike_3d_fine_store(i)    = 0.0
+         chisq_like_3d_coarse_store(i)    = 0.0
+         chisq_unlike_3d_coarse_store(i)  = 0.0
+         chisq_hist1_1_store(i)           = 0.0
+         chisq_hist1_2_store(i)           = 0.0
+         chisq_total_store(i)             = 0.0
+      end do
+
+      Return
+      END
+
+C---------------------------------------------------------------------
+
+
+      subroutine set_values
+      implicit none
+
+CCC   This subroutine sets parameters based on the main input.
+CCC   The consistency of the input parameters and controls is
+CCC   checked.  Any problems are reported in the Log File,
+CCC   'hbt_log.out'.  Most inconsistencies or array size limit
+CCC   overflows will cause the code execution to STOP.
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_coulomb.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+      Include 'common_particle.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 iphistep, ptmaxsteps, iptstep
+
+      real*4 px1,py1,pz1,E1, pt1,phi1
+      real*4 px2,py2,pz2,E2
+      real*4 pt_step,phi_step
+      real*4 pxstepmin, pxstepmax, pystepmin, pystepmax
+
+CCC  Check Input Controls:
+
+      if(ref_control .lt. 1 .or. ref_control .gt. 2) then
+         write(7,101) ref_control
+         errorcode = 1
+         Return
+      end if
+
+      if(switch_1d .lt. 0 .or. switch_1d .gt. 3) then
+         write(7,102) switch_1d
+         errorcode = 1
+         Return
+      end if
+
+      if(switch_3d .lt. 0 .or. switch_3d .gt. 2) then
+         write(7,103) switch_3d
+         errorcode = 1
+         Return
+      end if
+
+      if(switch_type .lt. 1 .or. switch_type .gt. 3) then
+         write(7,104) switch_type
+         errorcode = 1
+         Return
+      end if
+
+      if(switch_coherence .lt. 0 .or. switch_coherence .gt. 1) then
+         write(7,105) switch_coherence
+         errorcode = 1
+         Return
+      end if
+
+      if(switch_coulomb .lt. 0 .or. switch_coulomb .gt. 3) then
+         write(7,106) switch_coulomb
+         errorcode = 1
+         Return
+      end if
+
+      if(switch_fermi_bose.ne.-1 .and. switch_fermi_bose.ne.1) then
+         write(7,107) switch_fermi_bose
+         errorcode = 1
+         Return
+      end if 
+
+      if(n_pid_types .lt. 1 .or. n_pid_types .gt. 2) then
+         write(7,108) n_pid_types
+         errorcode = 1
+         Return
+      end if
+
+      if(switch_type .ge. 2 .and. n_pid_types .eq. 1) then
+         write(7,109) switch_type, n_pid_types
+         errorcode = 1
+         Return
+      end if
+
+      if(n_pid_types .eq. 1) then
+         if(pid(1).gt.0 .and. pid(2).gt.0) then
+            write(7,1091) pid(1),pid(2)
+            errorcode = 1
+            Return
+         end if
+      end if
+
+      if(pid(1).eq.0 .and. pid(2).eq.0) then
+         write(7,1092)
+         errorcode = 1
+         Return
+      end if
+
+      if(n_pid_types .eq. 2) then
+         if(pid(1).gt.0.and.pid(2).gt.0.and.pid(1).ne.pid(2))then
+            continue
+         else
+            write(7,1093) pid(1), pid(2)
+            errorcode = 1
+            Return
+         end if
+      end if
+
+      if(pid(1).gt.0.and.pid(2).gt.0.and.pid(1).eq.pid(2))then
+         write(7,1094) pid(1), pid(2)
+         errorcode = 1
+         Return
+      end if
+
+      if(trk_accep .le. 0.0) then
+         write(7,10941) trk_accep
+         errorcode = 1
+         Return
+
+      end if
+
+CCC   Check Input Parameters:
+
+      if(deltap .le. 0.0) deltap = 0.1
+      if(maxit  .lt. 0  ) maxit = 50
+      if(delchi .lt. 0.0) delchi = 0.1
+      if(irand  .le. 0  ) irand = 12345
+
+CCC   Check Coulomb source radius in range for Pratt type Coulomb correction.
+
+      if(switch_coulomb .eq. 3 .and. (Q0 .lt. coulradmin .or.
+     1   Q0 .gt. coulradmax)) then
+         write(7,132) Q0
+         errorcode = 1
+         Return
+      end if
+
+CCC   Load the Pratt type Coulomb correction if this form is selected.
+
+      if(switch_coulomb .eq. 3 .and. (Q0 .ge. coulradmin .and.
+     1   Q0 .le. coulradmax)) then
+         Call read_data(6)
+      end if
+
+CCC   Check and determine the one-body distribution's binning:
+
+      if(n_pt_bins .lt. 1 .or. n_pt_bins .gt. max_h_1d) then
+         write(7,110) n_pt_bins
+         errorcode = 1
+         Return
+      end if
+
+      if(n_phi_bins .lt. 1 .or. n_phi_bins .gt. max_h_1d) then
+         write(7,111) n_phi_bins
+         errorcode = 1
+         Return
+      end if
+
+      if(n_eta_bins .lt. 1 .or. n_eta_bins .gt. max_h_1d) then
+         write(7,112) n_eta_bins
+         errorcode = 1
+         Return
+      end if
+
+      if(pt_min .gt. pt_max .or. pt_min .lt. 0.0) then
+         write(7,113) pt_min, pt_max
+         errorcode = 1
+         Return
+      end if
+
+      if(phi_min.gt.phi_max .or. phi_min.lt.0.0 .or.
+     1   phi_max.gt.360.0) then
+         write(7,114) phi_min, phi_max
+         errorcode = 1
+         Return
+      end if
+
+      if(eta_min .gt. eta_max) then
+         write(7,115) eta_min, eta_max
+         errorcode = 1
+         Return
+      end if
+
+      pt_bin_size  = (pt_max  - pt_min )/float(n_pt_bins)
+      phi_bin_size = (phi_max - phi_min)/float(n_phi_bins)
+      eta_bin_size = (eta_max - eta_min)/float(n_eta_bins)
+
+CCC   Check and determine the two-body distribution's binning:
+
+      n_1d_total = n_1d_fine + n_1d_coarse
+      n_3d_total = n_3d_fine + n_3d_coarse - 1
+
+      if(switch_1d .gt. 0) then
+      if(n_1d_fine .lt. 1) then
+         write(7,116) n_1d_fine
+         errorcode = 1
+         Return
+      end if
+
+      if(n_1d_coarse .lt. 1) then
+         write(7,117) n_1d_coarse
+         errorcode = 1
+         Return
+      end if
+
+      if(n_1d_total .gt. max_h_1d) then
+         write(7,118) n_1d_total
+         errorcode = 1
+         Return
+      end if
+
+      qmid_1d = binsize_1d_fine  *float(n_1d_fine)
+      qmax_1d = binsize_1d_coarse*float(n_1d_coarse) + qmid_1d
+      end if
+
+      if(switch_3d .gt. 0) then
+      if(n_3d_fine .lt. 1 .or. n_3d_fine .gt. max_h_3d) then
+         write(7,119) n_3d_fine
+         errorcode = 1
+         Return
+      end if
+
+      if(n_3d_coarse .lt. 1 .or. n_3d_coarse .gt. max_h_3d) then
+         write(7,120) n_3d_coarse
+         errorcode = 1
+         Return
+      end if
+
+      qmid_3d = binsize_3d_fine  *float(n_3d_fine)
+      qmax_3d = binsize_3d_coarse*float(n_3d_coarse)
+
+      if(abs(qmid_3d - binsize_3d_coarse) .gt. 0.00001) then
+         write(7,121) qmid_3d, binsize_3d_coarse
+         errorcode = 1
+         Return
+      end if
+
+      if(n_3d_fine_project .gt. n_3d_fine) then
+         write(7,1211) n_3d_fine_project, n_3d_fine
+         n_3d_fine_project = n_3d_fine
+      end if
+
+      if(n_3d_fine_project .lt. 1) then
+         write(7,1212) n_3d_fine_project
+         n_3d_fine_project = 1
+      end if
+      end if
+
+CCC   Check and determine Track-Sector Parameters:
+
+      if(n_px_bins .lt. 1) then
+         write(7,122) n_px_bins
+         errorcode = 1
+         Return
+      end if
+
+      if(n_py_bins .lt. 1) then
+         write(7,123) n_py_bins
+         errorcode = 1
+         Return
+      end if
+
+      if(n_pz_bins .lt. 1) then
+         write(7,124) n_pz_bins
+         errorcode = 1
+         Return
+      end if
+
+      n_sectors = n_px_bins * n_py_bins * n_pz_bins
+      if(n_sectors .gt. sec_maxlen) then
+         write(7,125) n_sectors
+         errorcode = 1
+         Return
+      end if
+      if(n_sectors .gt. sec_maxlen2 .and. ref_control .eq. 2) then
+         write(7,1251) n_sectors
+         errorcode = 1
+         Return
+      end if
+
+      if(trk_maxlen .ne. trk2_maxlen .and. ref_control .eq. 2) then
+         write(7,1252)
+         errorcode = 1
+         Return
+      end if
+
+      if(max_trk_save .ne. max_trk_sec .or.
+     1   max_trk_save .ne. max_trk_sec2 .or.
+     2   max_trk_sec  .ne. max_trk_sec2) then
+         write(7,12521) max_trk_save,max_trk_sec,max_trk_sec2
+         errorcode = 1
+         Return
+      end if
+
+      delpx = (px_max - px_min)/float(n_px_bins)
+      delpy = (py_max - py_min)/float(n_py_bins)
+      delpz = (pz_max - pz_min)/float(n_pz_bins)
+
+CCC   Check that the Track-Sector Grid includes the acceptance range:
+CCC   The Track-Sector Grid is a 3D {px,py,pz} box, while the acceptance
+CCC   is defined in cylindrical {pt,phi,eta} coordinates.
+CCC
+CCC   Check the z-momentum components:
+
+      if(eta_min .ge. 0.0) then
+         Call Hbtp_kin(px1,py1,pz1,E1,pt_min,0.0,eta_min,0.14,2)
+         Call Hbtp_kin(px2,py2,pz2,E2,pt_max,0.0,eta_max,0.14,2)
+      else if(eta_max .le. 0.0) then
+         Call Hbtp_kin(px1,py1,pz1,E1,pt_max,0.0,eta_min,0.14,2)
+         Call Hbtp_kin(px2,py2,pz2,E2,pt_min,0.0,eta_max,0.14,2)
+      else if(eta_min .le. 0.0 .and. eta_max .ge. 0.0) then
+         Call Hbtp_kin(px1,py1,pz1,E1,pt_max,0.0,eta_min,0.14,2)
+         Call Hbtp_kin(px2,py2,pz2,E2,pt_max,0.0,eta_max,0.14,2)
+      end if
+
+      if(pz1 .lt. pz_min .or. pz2 .gt. pz_max) then
+         write(7,126) pz1,pz_min,pz2,pz_max
+         errorcode = 1
+         Return
+      end if
+
+CCC   Check the x,y-momentum components by scanning over the perimeter
+CCC   of the (pt,phi) acceptance domain space with 100 trial grid points.
+CCC   The overall required px_min, px_max, py_min and py_max to cover the
+CCC   acceptance by the track-sectors is determined.  These values are
+CCC   then compared with the min/max px and py ranges for the track-sectors.
+CCC
+CCC   Divide the pt and phi acceptance ranges into 24 equal steps:
+
+      pt_step  = (pt_max  - pt_min)/24.0
+      phi_step = (phi_max - phi_min)/24.0
+      pxstepmax = -1000.
+      pxstepmin =  1000.
+      pystepmax = -1000.
+      pystepmin =  1000.
+      phi1 = phi_min - phi_step
+      do iphistep = 1,25
+         phi1 = phi1 + phi_step
+         ptmaxsteps = 2
+         if(iphistep.eq.1 .or. iphistep.eq.25) ptmaxsteps = 25
+         pt1 = pt_min - pt_step
+         do iptstep = 1,ptmaxsteps
+            if(iphistep.eq.1 .or. iphistep.eq.25) then
+               pt1 = pt1 + pt_step
+            else if(iphistep.gt.1 .and. iphistep.lt.25) then
+               if(iptstep.eq.1) pt1 = pt_min
+               if(iptstep.eq.2) pt1 = pt_max
+            end if
+            Call Hbtp_kin(px1,py1,pz1,E1,pt1,phi1,0.0,0.14,2)
+               if(px1.gt.pxstepmax) pxstepmax = px1
+               if(px1.lt.pxstepmin) pxstepmin = px1
+               if(py1.gt.pystepmax) pystepmax = py1
+               if(py1.lt.pystepmin) pystepmin = py1
+         end do
+      end do
+
+      if(pxstepmin .lt. px_min .or. pxstepmax .gt. px_max) then
+         write(7,127) pxstepmin,px_min,pxstepmax,px_max
+         errorcode = 1
+         Return
+      end if
+
+      if(pystepmin .lt. py_min .or. pystepmax .gt. py_max) then
+         write(7,128) pystepmin,py_min,pystepmax,py_max
+         errorcode = 1
+         Return
+      end if
+
+CCC   Load Geant Particle Data:
+      Call Hbtp_particle_prop
+
+CCC   Check Requested Particle ID Numbers:
+
+      if(n_pid_types.eq.1 .and. pid(1).le.0 .and. pid(2).le.0) then
+         write(7,131) pid(1),pid(2)
+         errorcode = 1
+         Return
+      end if
+
+CCC   Initialize Masses to 0.0
+    
+      mass1 = 0.0
+      mass2 = 0.0
+
+      if(n_pid_types .eq. 1 .and. pid(1) .ne. 0) then
+         if(pid(1) .lt. 1 .or. pid(1) .gt. part_maxlen) then
+            write(7,129) pid(1)
+            errorcode = 1
+            Return
+         else
+            mass1 = part_mass(pid(1))
+         end if
+      else if(n_pid_types .eq. 1 .and. pid(2) .ne. 0) then
+         if(pid(2) .lt. 1 .or. pid(2) .gt. part_maxlen) then
+            write(7,130) pid(2)
+            errorcode = 1
+            Return
+         else
+            mass2 = part_mass(pid(2))
+         end if
+      else if(n_pid_types .eq. 2) then
+         if(pid(1) .lt. 1 .or. pid(1) .gt. part_maxlen) then
+            write(7,129) pid(1)
+            errorcode = 1
+            Return
+         else
+            mass1 = part_mass(pid(1))
+         end if
+         if(pid(2) .lt. 1 .or. pid(2) .gt. part_maxlen) then
+            write(7,130) pid(2)
+            errorcode = 1
+            Return
+         else
+            mass2 = part_mass(pid(2))
+         end if
+      end if
+
+CCC   Set Math Constants:
+
+      pi = 3.141592654
+      hbc = 0.19732891
+      rad = 180.0/pi
+
+CCC   FORMATS:
+
+101   Format(5x,'ref_control = ',I5,'Out of Range - STOP')
+102   Format(5x,'switch_1d   = ',I5,'Out of Range - STOP')
+103   Format(5x,'switch_3d   = ',I5,'Out of Range - STOP')
+104   Format(5x,'switch_type = ',I5,'Out of Range - STOP')
+105   Format(5x,'switch_coherence = ',I5,'Out of Range - STOP')
+106   Format(5x,'switch_coulomb = ',I5,'Out of Range - STOP')
+107   Format(5x,'switch_fermi_bose = ',I5,'Out of Range - STOP')
+108   Format(5x,'n_pid_types = ',I5,'Out of Range - STOP')
+109   Format(5x,'switch_type & n_pid_types = ',2I5,
+     1       'Incompatible - STOP')
+1091  Format(5x,'For n_pid_types=1, cannot have both PID#1,2 = ',
+     1       2I5,' .ne.0 - STOP')
+1092  Format(5x,'Both PID# 1 and 2 = 0, - STOP')
+1093  Format(5x,'For n_pid_types=2, PID#1,2 = ',2I5,
+     1      ' are incorrect - STOP')
+1094  Format(5x,'Both PID# 1,2 = ',2I5,' are equal - STOP')
+10941 Format(5x,'Track acceptance output frac .le. 0.0 - STOP')
+132   Format(5x,'Coulomb source radius = ',E12.4,' - For Pratt ',
+     1       'Correction, Out of Range - STOP')
+110   Format(5x,'# pt bins  = ',I5,'Out of Range - STOP')
+111   Format(5x,'# phi bins = ',I5,'Out of Range - STOP')
+112   Format(5x,'# eta bins = ',I5,'Out of Range - STOP')
+113   Format(5x,'pt min/max accept. range = ',2E12.4,' is wrong-STOP')
+114   Format(5x,'phi min/max accept. range = ',2E12.4,' is wrong-STOP')
+115   Format(5x,'eta min/max accept. range = ',2E12.4,' is wrong-STOP')
+116   Format(5x,'# 1d fine mesh for C2 = ',I5,' .lt.1 - STOP')
+117   Format(5x,'# 1d coarse mesh for C2 = ',I5,' .lt.1 - STOP')
+118   Format(5x,'Total # 1d mesh for C2 = ',I5,' .gt.max_h_1d - STOP')
+119   Format(5x,'# 3d fine mesh for C2 = ',I5,'Out of Range - STOP')
+120   Format(5x,'# 3d coarse mesh for C2 = ',I5,'Out of Range - STOP')
+121   Format(5x,'3D C2 fine range & coarse grid = ',2E12.4,
+     1       'Not Equal - STOP')
+1211  Format(5x,'# 3D fine bins projected = ',I5,
+     1       ' TOO BIG - reduce to n_3d_fine = ',I5)
+1212  Format(5x,'# 3D fine bins projected = ',I5,
+     1       ' Set to 1')
+122   Format(5x,'#track-sector px bins = ',I5,' .lt.1 - STOP')
+123   Format(5x,'#track-sector py bins = ',I5,' .lt.1 - STOP')
+124   Format(5x,'#track-sector pz bins = ',I5,' .lt.1 - STOP')
+125   Format(5x,'Total # trk-sec = ',I5,' .gt.sec_maxlen - STOP')
+1251  Format(5x,'Total # trk-sec = ',I5,' .gt.sec_maxlen2 for ',
+     1       'Reference calc. - STOP')
+1252  Format(5x,'trk_maxlen .ne. trk2_maxlen for Ref. Calc. - STOP')
+12521 Format(5x,'max_trk_save,max_trk_sec,max_trk_sec2 = ',
+     1       3I5,' are not all equal - STOP')
+126   Format(5x,'pz accept. not covered by sectors-STOP:',4E12.4)
+127   Format(5x,'px accept. not covered by sectors-STOP:',4E12.4)
+128   Format(5x,'py accept. not covered by sectors-STOP:',4E12.4)
+131   Format(5x,'Particle ID values = ',2I5,' not valid - STOP')
+129   Format(5x,'Particle ID value #1 = ',I5,' not valid - STOP')
+130   Format(5x,'Particle ID value #2 = ',I5,' not valid - STOP')
+
+      Return
+      END
+
+C----------------------------------------------------------------------
+
+
+      subroutine read_data(mode)
+      implicit none
+
+CCC   This subroutine does all the data input associated with all input
+C     files.  Some diagnostic output is printed here if errors occur
+C     during the file reading.  Two auxiliary output files, which tag
+C     the events input tracks are written out.
+C
+C     The type of input is controlled by the value of 'mode'
+C     where:
+C     (The following mostly applies to the standalone application
+C     that reads from files and writes temporary scratch files.
+C     This is the ALICE=0 mode.)
+C
+C        mode = 1, read the parameter and switches input file
+C
+C        mode = 2, scan the event text file and write out two
+C                  auxiliary output/tag files; select and mark
+C                  accepted tracks to use.
+C
+C        mode = 3, read the reference pair and one-body histograms
+C
+C        mode = 4, read the next event from the event text file, 
+C                  'event_text.in,' and load the accepted tracks
+C                  into the 'trk' data structure.
+C
+C        mode = 5, same as mode=4, except the accepted tracks are
+C                  loaded into the 'trk2' data structure.
+C
+C        mode = 6, read the input Coulomb correction tables and
+C                  interpolate for the requested source radius, arrays
+C                  in common/coulomb/ are filled for like and unlike
+C                  charged pairs.
+C
+C        mode = 7, read the next event from the event text file, 
+C                  'event_text.in,' and load the accepted tracks
+C                  into the 'trk' data structure. Then copy the event
+C                  data in 'event_text.in' to 'event_text_aux.in' and
+C                  from 'event_tracks.select' to 'event_tracks_aux.select'
+C
+C        mode = 8, read contents of 'event_text_aux.in' using flag values
+C                  in 'event_tracks_aux.select' and copy into
+C                  'event_hbt_text.out' (i.e. the main event output file)
+C                  where the momentum values for accepted tracks are
+C                  overwritten with the adjusted (correlated) parameters
+C                  in the 'trk' data structure.
+C
+C                  If trk_accep .lt. 1.0, then only write this fraction
+C                  of the final tracks, as determined by a random number
+C                  throw.
+C
+C     Summary of Files:
+C     ----------------
+C
+C File Unit #        Filename               Description
+C ---------------------------------------------------------------------------
+C     1       hbt_parameters.in          Input switches, parameters
+C     2       event_text.in              Event Gen output, GSTAR text format
+C     3       event_line.flags           Event file line flags
+C     4       event_tracks.select        Event file selected tracks
+C     7       hbt_log.out                Log and error messages
+C     8       hbt_simulation.out         Full Output
+C     9       hbt_pair_reference.hist    Reference pair histograms
+C    10       event_hbt_text.out         Updated/correlated event text file
+C    11       hbt_singles_reference.hist Reference one-body histograms
+C    12       event_text_aux.in          Tmp. copy of 'event_text.in'/event
+C    14       event_tracks_aux.select    Tmp. copy 'event_tracks.select'/event
+C   21-27     cpp_*.dat (*=06,08,...18)  Like pair Pratt Coul. Correct
+C   31-37     cpm_*.dat (*=06,08,...18)  Unlike pair Pratt Coul. Correct
+C ---------------------------------------------------------------------------
+C
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_coulomb.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_particle.inc'
+
+      integer LNBLNK  
+
+CCC   Local Variable Type Declarations:
+
+      real*4 px,py,pz,E,pt,phi,eta,mass
+      real*4 acheck(10), function(20)
+      real*4 hbtpran
+
+      integer*4 i,j,k,mode,flag,flag4,flag0,ntracks
+      integer*4 ge_pid,tid,start_v,stop_v,eg_pid
+      integer*4 ref_check,pidok,accepok,check(13)
+      integer*4 event_counter,track_counter
+      integer*4 track_counter_1,track_counter_2
+
+      character*5 evg_label,event_line,vertex_line,track_line,dummy
+      character*5 gener_line
+      character*80 comment_event_label
+      character*87 vertex_label
+      character*93 gener_label
+
+      parameter (event_line  = 'EVENT')
+      parameter (vertex_line = 'VERTE')
+      parameter (track_line  = 'TRACK')
+      parameter (gener_line  = 'GENER')
+      parameter (flag4 = 4)
+      parameter (flag0 = 0)
+C     ALICE USE ONLY 
+      CHARACTER*100 CHROOT  
+      CHARACTER*100 FILNAM
+      INTEGER*4 LNROOT
+      LOGICAL EXISTS
+      CHROOT=' '
+C     
+      
+CCC   Begin Data Input Options:
+
+C------------------------
+      IF (mode.eq.1) THEN              ! Read Input parameters from File#1
+C------------------------
+      
+CCC   For standalone version (ALICE = 0), read parameters from
+CCC   File Unit=1, 'hbt_parameters.in'
+CCC   For ALICE-ROOT version (ALICE=1) load parameters from Call to C++ funct
+      If(ALICE .eq. 1) then
+         Call AliHbtp_SetParameters
+      Else If(ALICE .eq. 0) Then
+
+         open(unit=1,type='old',access='sequential',
+     1        name='hbt_parameters.in')
+
+CCC   Read Control Switches:  (See Main program listing for complete
+CCC                            description of input parameters)
+
+      read(1,*) ref_control
+      read(1,*) switch_1d
+      read(1,*) switch_3d
+      read(1,*) switch_type
+      read(1,*) switch_coherence
+      read(1,*) switch_coulomb
+      read(1,*) switch_fermi_bose
+      read(1,*) trk_accep
+      read(1,*) print_full
+      read(1,*) print_sector_data
+
+CCC   Read Parameters:
+
+      read(1,*) n_pid_types
+      read(1,*) pid(1),pid(2)
+      read(1,*) deltap
+      read(1,*) maxit
+      read(1,*) delchi
+      read(1,*) irand
+
+CCC   Read Source Parameters:
+
+      read(1,*) lambda
+      read(1,*) R_1d
+      read(1,*) Rside, Rout, Rlong
+      read(1,*) Rperp, Rparallel, R0
+      read(1,*) Q0
+
+CCC   Read one-body {pt,phi,eta} bins:
+
+      read(1,*) n_pt_bins ,pt_min ,pt_max
+      read(1,*) n_phi_bins,phi_min,phi_max
+      read(1,*) n_eta_bins,eta_min,eta_max
+
+CCC   Read two-body 1D and 3D bins:
+
+      read(1,*) n_1d_fine,   binsize_1d_fine
+      read(1,*) n_1d_coarse, binsize_1d_coarse
+      read(1,*) n_3d_fine,   binsize_3d_fine
+      read(1,*) n_3d_coarse, binsize_3d_coarse
+      read(1,*) n_3d_fine_project
+
+CCC   Read momentum space track sector bins in {px,py,pz}:
+
+      read(1,*) n_px_bins,px_min,px_max
+      read(1,*) n_py_bins,py_min,py_max
+      read(1,*) n_pz_bins,pz_min,pz_max
+
+CCC   Relative Chi-Square weights for track adjustment fitting:
+
+      read(1,*) chisq_wt_like_1d
+      read(1,*) chisq_wt_unlike_1d
+      read(1,*) chisq_wt_like_3d_fine
+      read(1,*) chisq_wt_unlike_3d_fine
+      read(1,*) chisq_wt_like_3d_coarse
+      read(1,*) chisq_wt_unlike_3d_coarse
+      read(1,*) chisq_wt_hist1_1
+      read(1,*) chisq_wt_hist1_2
+
+      Close(unit=1)
+      End If  !  ALICE Data I/O Option
+
+C-----------------------------
+      ELSE IF (mode.eq.2) THEN    
+C-----------------------------
+
+C     Open event generator text file, 'event_text.in,' and read it,
+C     noting each type of line input.  Write out a file called 
+C     'event_line.flags' which identifies the type of information on
+C     each line where:
+C
+C        'EVENT:'  lines are assigned flag = 1
+C        'VERTEX:' lines are assigned flag = 2
+C        'TRACK:'  lines are assigned flag = 3
+C        'GENER:'  lines are assigned flag = 5
+C        All other lines are assigned flag = 0
+
+      If(ALICE .eq. 0) Then
+      open(unit=2,type='old',access='sequential',
+     1     name='event_text.in')
+      open(unit=3,status='unknown',access='sequential',
+     1     name='event_line.flags')
+
+CCC   Set Event Counter:
+
+      event_counter = 0
+30    read(2,10,err=20,end=25) evg_label
+10    Format(A)
+      if(evg_label .eq. event_line) then
+         event_counter = event_counter + 1
+         flag = 1
+      else if(evg_label .eq. vertex_line) then
+         flag = 2
+      else if(evg_label .eq. track_line) then
+         flag = 3
+      else if(evg_label .eq. gener_line) then
+         flag = 5
+      else
+         flag = 0
+      end if
+
+      write(3,11) flag
+11    Format(1x,I1)
+      go to 30         ! Return to S.N. 30 and read next line in file
+20    write(7,12) event_counter
+12    Format(5x,'Read error in event_text.in at event# ',I5,' - STOP')
+      Stop
+25    Continue
+      Close(unit=2)
+      Close(unit=3)
+      End If  !  ALICE Data I/O Option
+
+C     Next, re-open the 'event_text.in' and 'event_line.flags' files
+C     again and read thru the entire files.  For each track, check its'
+C     particle ID and kinematics (pt,phi,eta) with respect to the
+C     selected particle ID type(s) for the run and the acceptances.
+C     Fill another file called, 'event_tracks.select,' which is the same
+C     as 'event_line.flags' except that the accepted tracks are marked
+C     with flag = 4.
+C
+C     NOTE:  Assume all vertices in 'event_text.in' are at microscopic
+C            distances (fermis) such that all particles in the event
+C            file are considered as primaries.  Also for each event
+C            the code will only accept tracks up to the limit imposed
+C            by trk_maxlen in the 'trk' table.
+
+      If(ALICE .eq. 1) Then
+CCC   For ALICE application do the following:
+CCC      Store number of events in 'n_events'
+CCC      Count number accepted tracks in each event, check wrt trk_maxlen
+CCC      Mark accepted tracks in all events
+
+         Call AliHbtp_GetNumberEvents(n_events)
+         do i = 1,n_events
+            Call AliHbtp_SetActiveEventNumber(i)
+            track_counter = 0
+            Call AliHbtp_GetNumberTracks(ntracks)
+            do j = 1,ntracks
+               Call AliHbtp_GetTrack(j,flag,px,py,pz,ge_pid)
+               eg_pid = ge_pid
+CCC   Check if this track's particle ID is one to be used
+
+         pidok = 0
+         accepok = 0
+         if(pid(1).gt.0 .and. eg_pid.eq.pid(1)) pidok = 1
+         if(pid(2).gt.0 .and. eg_pid.eq.pid(2)) pidok = 1
+         if(pidok.eq.1 .and. eg_pid.le.part_maxlen) then
+            mass = part_mass(eg_pid)
+            Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+            if(pt.ge.pt_min .and. pt.le.pt_max .and.
+     1         phi.ge.phi_min .and. phi.le.phi_max .and.
+     2         eta.ge.eta_min .and. eta.le.eta_max) then
+               if(track_counter .lt. trk_maxlen) then
+                  accepok = 1
+               else
+                  write(7,62) trk_maxlen, event_counter
+62                Format(5x,'#tracks exceeds trk_maxlen = ',
+     1                  I6,' for event#',I4)
+               end if
+            end if
+         end if
+
+         if(pidok.eq.1 .and. accepok.eq.1) then
+            track_counter = track_counter + 1
+C          write(*,*) '  FFF: 1 calling PutTrack j = ',j
+            Call AliHbtp_PutTrack(j,flag4,px,py,pz,ge_pid)
+         else
+C          write(*,*) '  FFF: 2 calling PutTrack j = ',j
+            Call AliHbtp_PutTrack(j,flag0,px,py,pz,ge_pid)
+         end if
+         end do
+         end do
+      
+      Else If(ALICE .eq. 0) Then
+
+      open(unit=2,type='old',access='sequential',
+     1     name='event_text.in')
+      open(unit=3,type='old',access='sequential',
+     1     name='event_line.flags')
+      open(unit=4,status='unknown',access='sequential',
+     1     name='event_tracks.select')
+
+CCC   Set Event Counter:
+
+      event_counter = 0
+40    read(3,11,err=45,end=50) flag
+      if(flag.eq.1) then
+         event_counter = event_counter + 1
+         track_counter = 0
+      end if
+
+      if(flag.ne.3) then
+         read(2,10) dummy
+         write(4,11) flag
+      else if(flag.eq.3) then
+         read(2,41,err=46,end=50) ge_pid,px,py,pz,tid,start_v,
+     1                            stop_v,eg_pid
+41    Format(7x,I6,3(1x,G12.5),4(1x,I6))
+
+CCC   Check if the 'event_text.in' file includes non-zero PID
+CCC   values for the variable 'eg_pid'.  If this is zero, then
+CCC   use the ge_pid value.
+         if(eg_pid.eq.0 .and. ge_pid.ne.0) eg_pid = ge_pid
+
+CCC   Check if this track's particle ID is one to be used
+
+         pidok = 0
+         accepok = 0
+         if(pid(1).gt.0 .and. eg_pid.eq.pid(1)) pidok = 1
+         if(pid(2).gt.0 .and. eg_pid.eq.pid(2)) pidok = 1
+         if(pidok.eq.1 .and. eg_pid.le.part_maxlen) then
+            mass = part_mass(eg_pid)
+            Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+            if(pt.ge.pt_min .and. pt.le.pt_max .and.
+     1         phi.ge.phi_min .and. phi.le.phi_max .and.
+     2         eta.ge.eta_min .and. eta.le.eta_max) then
+               if(track_counter .lt. trk_maxlen) then
+                  accepok = 1
+               else
+                  write(7,621) trk_maxlen, event_counter
+621                Format(5x,'#tracks exceeds trk_maxlen = ',
+     1                  I6,' for event#',I4)
+               end if
+            end if
+         end if
+
+         if(pidok.eq.1 .and. accepok.eq.1) then
+            track_counter = track_counter + 1
+            write(4,11) flag4
+         else
+            write(4,11) flag
+         end if
+    
+      end if    ! End Flag=3 options
+
+      go to 40  ! Return to S.N. 40 and read next record
+45    write(7,60) event_counter
+60    Format(5x,'Read error in event_line.flags at event#',I5,
+     1       ' - STOP')
+      Stop
+46    write(7,61) event_counter
+61    Format(5x,'Read error in event_text.in (2nd pass) at event#',I5,
+     1       ' - STOP')
+      Stop
+50    Continue
+      
+      n_events = event_counter - 1  !  Set # events in event_text.in file
+C                                   !  This is one less than the counter
+C                                   !  value since the last 'EVENT:' line is
+C                                   !  used to mark the End-of-File.
+
+      Close(unit=2)
+      Close(unit=3)
+      Close(unit=4)
+
+      End If    !  ALICE Data I/O Option
+
+C-----------------------------
+      ELSE IF(mode.eq.3) THEN
+C-----------------------------
+
+C     Read the reference histograms for pairs, then for singles for one
+C     or two particle ID types.  Check switches, bins and mesh information
+C     to be sure the input reference histograms are compatible with the
+C     present run conditions.
+
+      open(unit=9,type='old',access='sequential',
+     1     name='hbt_pair_reference.hist')
+
+      read(9,*) (check(i),i=1,3)
+      read(9,*)  check(4),acheck(1),acheck(2)
+      read(9,*)  check(5),acheck(3),acheck(4)
+      read(9,*)  check(6),acheck(5),acheck(6)
+      read(9,*) (check(i),i=7,9)
+      read(9,*) (check(i),i=10,13)
+      read(9,*) (acheck(i),i=7,10)
+      read(9,*) num_pairs_like_ref, num_pairs_unlike_ref
+
+CCC   Determine if the Input Reference pair histograms are compatible
+CCC   with the present run parameters:
+
+      ref_check = 1
+      if(check(1)  .ne. n_pid_types ) ref_check = 0
+      if(check(2)  .ne. pid(1)      ) ref_check = 0
+      if(check(3)  .ne. pid(2)      ) ref_check = 0
+      if(check(4)  .ne. n_pt_bins   ) ref_check = 0
+      if(check(5)  .ne. n_phi_bins  ) ref_check = 0
+      if(check(6)  .ne. n_eta_bins  ) ref_check = 0
+      if(check(7)  .ne. switch_1d   ) ref_check = 0
+      if(check(8)  .ne. switch_3d   ) ref_check = 0
+      if(check(9)  .ne. switch_type ) ref_check = 0
+      if(check(10) .ne. n_1d_fine   ) ref_check = 0
+      if(check(11) .ne. n_1d_coarse ) ref_check = 0
+      if(check(12) .ne. n_3d_fine   ) ref_check = 0
+      if(check(13) .ne. n_3d_coarse ) ref_check = 0
+
+      if(abs(acheck( 1) - pt_min )         .gt. 0.000001) ref_check = 0
+      if(abs(acheck( 2) - pt_max )         .gt. 0.000001) ref_check = 0
+      if(abs(acheck( 3) - phi_min )        .gt. 0.000001) ref_check = 0
+      if(abs(acheck( 4) - phi_max )        .gt. 0.000001) ref_check = 0
+      if(abs(acheck( 5) - eta_min )        .gt. 0.000001) ref_check = 0
+      if(abs(acheck( 6) - eta_max )        .gt. 0.000001) ref_check = 0
+      if(abs(acheck( 7) - binsize_1d_fine) .gt. 0.000001) ref_check = 0
+      if(abs(acheck( 8) - binsize_1d_coarse).gt.0.000001) ref_check = 0
+      if(abs(acheck( 9) - binsize_3d_fine) .gt. 0.000001) ref_check = 0
+      if(abs(acheck(10) - binsize_3d_coarse).gt.0.000001) ref_check = 0
+
+      if(ref_check .eq. 0) then
+         write(7,70)
+70    Format(5x,'Reference Pair Histogram Parameters not consistent',
+     1       ' with present run conditions - STOP')
+         errorcode = 1
+         Return
+      else if(ref_check .eq. 1) then
+
+         if(switch_1d.gt.0 .and. n_1d_total.gt.0) then
+            if(switch_type.eq.1 .or. switch_type.eq.3) then
+               read(9,*) (href_like_1d(i),i=1,n_1d_total)
+            end if
+            if(switch_type.eq.2 .or. switch_type.eq.3) then
+               read(9,*) (href_unlike_1d(i),i=1,n_1d_total)
+            end if
+         end if   ! End 1D input option
+
+         if(switch_3d.gt.0) then
+            if(switch_type.eq.1 .or. switch_type.eq.3) then
+
+               if(n_3d_fine.gt.0) then
+                  do i = 1,n_3d_fine
+                  do j = 1,n_3d_fine
+                  do k = 1,n_3d_fine
+                     read(9,*) href_like_3d_fine(i,j,k)
+                  end do
+                  end do
+                  end do
+               end if
+
+               if(n_3d_coarse.gt.0) then
+                  do i = 1,n_3d_coarse
+                  do j = 1,n_3d_coarse
+                  do k = 1,n_3d_coarse
+                     read(9,*) href_like_3d_coarse(i,j,k)
+                  end do
+                  end do
+                  end do
+               end if
+
+            end if
+
+            if(switch_type.eq.2 .or. switch_type.eq.3) then
+
+               if(n_3d_fine.gt.0) then
+                  do i = 1,n_3d_fine
+                  do j = 1,n_3d_fine
+                  do k = 1,n_3d_fine
+                     read(9,*) href_unlike_3d_fine(i,j,k)
+                  end do
+                  end do
+                  end do
+               end if
+
+               if(n_3d_coarse.gt.0) then
+                  do i = 1,n_3d_coarse
+                  do j = 1,n_3d_coarse
+                  do k = 1,n_3d_coarse
+                     read(9,*) href_unlike_3d_coarse(i,j,k)
+                  end do
+                  end do
+                  end do
+               end if
+
+            end if
+
+         end if     ! End 3D input option
+      end if        ! End Reference Check OK/Not OK Option
+
+      Close(unit=9)
+
+CCC   Next read the one-body histograms for 1 or 2 particle ID types:
+
+      open(unit=11,type='old',access='sequential',
+     1     name='hbt_singles_reference.hist')
+
+      read(11,*) (check(i),i=1,3)
+      read(11,*)  check(4),acheck(1),acheck(2)
+      read(11,*)  check(5),acheck(3),acheck(4)
+      read(11,*)  check(6),acheck(5),acheck(6)
+      read(11,*) n_part_used_1_ref, n_part_used_2_ref
+
+CCC   Determine if Reference one-body histograms are compatible with
+CCC   the present run conditions.
+
+      ref_check = 1
+      if(check(1) .ne. n_pid_types)   ref_check = 0
+      if(check(2) .ne. pid(1)     )   ref_check = 0
+      if(check(3) .ne. pid(2)     )   ref_check = 0
+      if(check(4) .ne. n_pt_bins  )   ref_check = 0
+      if(check(5) .ne. n_phi_bins )   ref_check = 0
+      if(check(6) .ne. n_eta_bins )   ref_check = 0
+
+      if(abs(acheck(1) - pt_min  ).gt.0.000001) ref_check = 0
+      if(abs(acheck(2) - pt_max  ).gt.0.000001) ref_check = 0
+      if(abs(acheck(3) - phi_min ).gt.0.000001) ref_check = 0
+      if(abs(acheck(4) - phi_max ).gt.0.000001) ref_check = 0
+      if(abs(acheck(5) - eta_min ).gt.0.000001) ref_check = 0
+      if(abs(acheck(6) - eta_max ).gt.0.000001) ref_check = 0
+
+      if(ref_check .eq. 0) then
+         write(7,71)
+71       Format(5x,'Reference One-Body Histogram parameters not ',
+     1          'consistent with current run - STOP')
+         errorcode = 1
+         Return
+      else if(ref_check .eq. 1) then
+
+         if(pid(1).gt.0) then
+            read(11,*) (href1_pt_1(i) ,i=1,n_pt_bins)
+            read(11,*) (href1_phi_1(i),i=1,n_phi_bins)
+            read(11,*) (href1_eta_1(i),i=1,n_eta_bins)
+         end if
+
+         if(pid(2).gt.0) then
+            read(11,*) (href1_pt_2(i) ,i=1,n_pt_bins)
+            read(11,*) (href1_phi_2(i),i=1,n_phi_bins)
+            read(11,*) (href1_eta_2(i),i=1,n_eta_bins)
+         end if
+
+      end if    ! End one-body reference histogram input
+
+      Close(unit=11)
+
+C-----------------------------
+      ELSE IF(mode.eq.4) THEN
+C-----------------------------
+
+CCC   Read the next event from 'event_text.in' and load accepted tracks
+C     into the 'trk' data structure using the flag information about each
+C     line type in the file 'event_tracks.select'.
+C
+C     For this mode to run successfully the calling program must:
+C       (1) initially set the event_line_counter = 0
+C       (2) open the 'event_text.in' and 'event_tracks.select' files
+C           as units 2 and 4, respectively.
+C       (3) Close units 2 and 4 when finished.
+
+CCC   Initialize accepted track counters for this new event:
+
+      track_counter   = 0     ! Counts all accepted tracks
+      track_counter_1 = 0     ! Counts all accepted tracks of type pid(1)
+      track_counter_2 = 0     ! Counts all accepted tracks of type pid(2)
+
+      If(ALICE .eq. 1) Then
+         Call AliHbtp_GetNumberTracks(ntracks)
+         do i = 1,ntracks
+            Call AliHbtp_GetTrack(i,flag,px,py,pz,ge_pid)
+            eg_pid = ge_pid
+            if(flag.eq.flag4) then
+         track_counter = track_counter + 1
+
+         if(eg_pid.eq.pid(1) .and. pid(1).gt.0) then
+            track_counter_1 = track_counter_1 + 1
+         end if
+
+         if(eg_pid.eq.pid(2) .and. pid(2).gt.0) then
+            track_counter_2 = track_counter_2 + 1
+         end if
+
+         mass = part_mass(eg_pid)
+         Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+         trk_ge_pid(track_counter)        = eg_pid
+         trk_px(track_counter)            = px
+         trk_py(track_counter)            = py
+         trk_pz(track_counter)            = pz
+         trk_id(track_counter)            = track_counter
+         trk_start_vertex(track_counter)  = 0
+         trk_stop_vertex(track_counter)   = 0
+         trk_event_line(track_counter)    = 0
+         trk_flag(track_counter)          = 0
+         trk_px_sec(track_counter)        = 0
+         trk_py_sec(track_counter)        = 0
+         trk_pz_sec(track_counter)        = 0
+         trk_sector(track_counter)        = 0
+         trk_out_flag(track_counter)      = 0
+         trk_merge_flag(track_counter)    = 0
+         trk_E(track_counter)             = E
+         trk_pt(track_counter)            = pt
+         trk_phi(track_counter)           = phi
+         trk_eta(track_counter)           = eta
+        end if
+       end do
+         n_part_1_trk   = track_counter_1
+         n_part_2_trk   = track_counter_2
+         n_part_tot_trk = track_counter
+
+      Else If(ALICE .eq. 0) Then
+
+80    read(4,11,err=81,end=82) flag
+      event_line_counter = event_line_counter + 1
+      
+      if(flag .ne. 4) then
+         read(2,10,err=83,end=82) dummy
+      else if(flag .eq. 4) then
+         read(2,41) ge_pid,px,py,pz,tid,start_v,stop_v,eg_pid
+
+CCC   Check if the 'event_text.in' file includes non-zero PID
+CCC   values for the variable 'eg_pid'.  If this is zero, then
+CCC   use the ge_pid value.
+         if(eg_pid.eq.0 .and. ge_pid.ne.0) eg_pid = ge_pid
+
+         track_counter = track_counter + 1
+      
+         if(eg_pid.eq.pid(1) .and. pid(1).gt.0) then
+            track_counter_1 = track_counter_1 + 1
+         end if
+
+         if(eg_pid.eq.pid(2) .and. pid(2).gt.0) then
+            track_counter_2 = track_counter_2 + 1
+         end if
+
+         mass = part_mass(eg_pid)
+         Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+         trk_ge_pid(track_counter)        = eg_pid
+         trk_px(track_counter)            = px
+         trk_py(track_counter)            = py
+         trk_pz(track_counter)            = pz
+         trk_id(track_counter)            = track_counter
+         trk_start_vertex(track_counter)  = start_v
+         trk_stop_vertex(track_counter)   = stop_v
+         trk_event_line(track_counter)    = event_line_counter
+         trk_flag(track_counter)          = 0
+         trk_px_sec(track_counter)        = 0
+         trk_py_sec(track_counter)        = 0
+         trk_pz_sec(track_counter)        = 0
+         trk_sector(track_counter)        = 0
+         trk_out_flag(track_counter)      = 0
+         trk_merge_flag(track_counter)    = 0
+         trk_E(track_counter)             = E
+         trk_pt(track_counter)            = pt
+         trk_phi(track_counter)           = phi
+         trk_eta(track_counter)           = eta
+      end if
+
+      if(flag.ne.1) then
+         go to 80   ! Return to S.N. 80 and read next record in file
+      else if(flag.eq.1) then
+         n_part_1_trk   = track_counter_1
+         n_part_2_trk   = track_counter_2
+         n_part_tot_trk = track_counter
+      end if
+
+82    Return
+81    write(7,84)
+84    Format(5x,'Read error from file event_tracks.select for mode=4',
+     1       ' - STOP')
+      Stop
+83    write(7,85)
+85    Format(5x,'Read error from file event_text.in for mode=4',
+     1       ' - STOP')
+      Stop
+      End If  !  ALICE Data I/O Option
+
+C-----------------------------
+      ELSE IF(mode.eq.5) THEN
+C-----------------------------
+
+CCC   Read the next event from 'event_text.in' and load accepted tracks
+C     into the 'trk2' data structure using the flag information about each
+C     line type in the file 'event_tracks.select'.
+C
+C     For this mode to run successfully the calling program must:
+C       (1) initially set the event_line_counter = 0
+C       (2) open the 'event_text.in' and 'event_tracks.select' files
+C           as units 2 and 4, respectively.
+C       (3) Close units 2 and 4 when finished.
+
+CCC   Initialize accepted track counters for this new event:
+
+      track_counter   = 0     ! Counts all accepted tracks
+      track_counter_1 = 0     ! Counts all accepted tracks of type pid(1)
+      track_counter_2 = 0     ! Counts all accepted tracks of type pid(2)
+
+      If(ALICE .eq. 1) Then
+         Call AliHbtp_GetNumberTracks(ntracks)
+         do i = 1,ntracks
+            Call AliHbtp_GetTrack(i,flag,px,py,pz,ge_pid)
+            eg_pid = ge_pid
+            if(flag.eq.flag4) then
+         track_counter = track_counter + 1
+
+         if(eg_pid.eq.pid(1) .and. pid(1).gt.0) then
+            track_counter_1 = track_counter_1 + 1
+         end if
+
+         if(eg_pid.eq.pid(2) .and. pid(2).gt.0) then
+            track_counter_2 = track_counter_2 + 1
+         end if
+
+         mass = part_mass(eg_pid)
+         Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+         trk2_ge_pid(track_counter)        = eg_pid
+         trk2_px(track_counter)            = px
+         trk2_py(track_counter)            = py
+         trk2_pz(track_counter)            = pz
+         trk2_id(track_counter)            = track_counter
+         trk2_start_vertex(track_counter)  = 0
+         trk2_stop_vertex(track_counter)   = 0
+         trk2_event_line(track_counter)    = 0
+         trk2_flag(track_counter)          = 0
+         trk2_px_sec(track_counter)        = 0
+         trk2_py_sec(track_counter)        = 0
+         trk2_pz_sec(track_counter)        = 0
+         trk2_sector(track_counter)        = 0
+         trk2_out_flag(track_counter)      = 0
+         trk2_merge_flag(track_counter)    = 0
+         trk2_E(track_counter)             = E
+         trk2_pt(track_counter)            = pt
+         trk2_phi(track_counter)           = phi
+         trk2_eta(track_counter)           = eta
+        end if
+       end do
+         n_part_1_trk2   = track_counter_1
+         n_part_2_trk2   = track_counter_2
+         n_part_tot_trk2 = track_counter
+
+      Else If(ALICE.eq.0) Then
+
+90    read(4,11,err=91,end=92) flag
+      event_line_counter = event_line_counter + 1
+      
+      if(flag .ne. 4) then
+         read(2,10,err=93,end=92) dummy
+      else if(flag .eq. 4) then
+         read(2,41) ge_pid,px,py,pz,tid,start_v,stop_v,eg_pid
+
+CCC   Check if the 'event_text.in' file includes non-zero PID
+CCC   values for the variable 'eg_pid'.  If this is zero, then
+CCC   use the ge_pid value.
+         if(eg_pid.eq.0 .and. ge_pid.ne.0) eg_pid = ge_pid
+
+         track_counter = track_counter + 1
+      
+         if(eg_pid.eq.pid(1) .and. pid(1).gt.0) then
+            track_counter_1 = track_counter_1 + 1
+         end if
+
+         if(eg_pid.eq.pid(2) .and. pid(2).gt.0) then
+            track_counter_2 = track_counter_2 + 1
+         end if
+
+         mass = part_mass(eg_pid)
+         Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+         trk2_ge_pid(track_counter)        = eg_pid
+         trk2_px(track_counter)            = px
+         trk2_py(track_counter)            = py
+         trk2_pz(track_counter)            = pz
+         trk2_id(track_counter)            = track_counter
+         trk2_start_vertex(track_counter)  = start_v
+         trk2_stop_vertex(track_counter)   = stop_v
+         trk2_event_line(track_counter)    = event_line_counter
+         trk2_flag(track_counter)          = 0
+         trk2_px_sec(track_counter)        = 0
+         trk2_py_sec(track_counter)        = 0
+         trk2_pz_sec(track_counter)        = 0
+         trk2_sector(track_counter)        = 0
+         trk2_out_flag(track_counter)      = 0
+         trk2_merge_flag(track_counter)    = 0
+         trk2_E(track_counter)             = E
+         trk2_pt(track_counter)            = pt
+         trk2_phi(track_counter)           = phi
+         trk2_eta(track_counter)           = eta
+      end if
+
+      if(flag.ne.1) then
+         go to 90   ! Return to S.N. 90 and read next record in file
+      else if(flag.eq.1) then
+         n_part_1_trk2   = track_counter_1
+         n_part_2_trk2   = track_counter_2
+         n_part_tot_trk2 = track_counter
+      end if
+
+92    Return
+91    write(7,94)
+94    Format(5x,'Read error from file event_tracks.select for mode=5',
+     1       ' - STOP')
+      Stop
+93    write(7,95)
+95    Format(5x,'Read error from file event_text.in for mode=5',
+     1       ' - STOP')
+      Stop
+
+      End If   !  ALICE Data I/O Option
+
+C-----------------------------
+      ELSE IF(mode.eq.6) THEN
+C-----------------------------
+
+CCC   Read finite source size Coulomb pair correlation corrections and
+CCC   interpolate to requested source radius and save the results for q,
+CCC   like and unlike pairs in common/coulomb/.
+
+      if(switch_coulomb.eq.3 .and. Q0.ge.coulradmin .and.
+     1   Q0.le.coulradmax) then
+
+CCC   Initially, read and interpolate like pair Coulomb corrections:
+C     ALICE
+
+      If(ALICE .eq. 1) then
+      
+        CALL GETENVF('ALICE_ROOT',CHROOT)
+        LNROOT = LNBLNK(CHROOT)
+        
+        IF(LNROOT.LE.0) THEN 
+         PRINT*,'**********************************'
+         PRINT*,'*        HBT PROCESSOR           *'
+         PRINT*,'*        -----------             *'
+         PRINT*,'*   DATA File  not found         *'
+         PRINT*,'*         Program STOP           *'
+         PRINT*,'*   Check ALICE_ROOT environment *'
+         PRINT*,'*           variable             *'
+         PRINT*,'**********************************'        
+         errorcode = 1
+         return
+        ENDIF
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpp_06.dat' 
+       open(unit=21,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpp_08.dat' 
+       open(unit=22,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpp_10.dat' 
+       open(unit=23,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpp_12.dat' 
+       open(unit=24,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpp_14.dat' 
+       open(unit=25,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpp_16.dat' 
+       open(unit=26,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpp_18.dat' 
+       open(unit=27,type='old',access='sequential',
+     1       name=FILNAM)
+       
+      ELSE
+        open(unit=21,type='old',access='sequential',
+     1       name='cpp_06.dat')
+        open(unit=22,type='old',access='sequential',
+     1       name='cpp_08.dat')
+        open(unit=23,type='old',access='sequential',
+     1       name='cpp_10.dat')
+        open(unit=24,type='old',access='sequential',
+     1       name='cpp_12.dat')
+        open(unit=25,type='old',access='sequential',
+     1       name='cpp_14.dat')
+        open(unit=26,type='old',access='sequential',
+     1       name='cpp_16.dat')
+        open(unit=27,type='old',access='sequential',
+     1       name='cpp_18.dat')
+      ENDIF
+      
+
+      do i = 1,max_c2_coul
+         do j = 1,ncoulradsteps
+            read(20+j,*) q_coul(i), function(j)
+         end do
+         Call AliHbtp_interp(coulradmin,coulradmax,coulradstep,
+     1        ncoulradsteps,function,20,Q0,c2_coul_like(i))
+      end do
+
+      close(unit=21)
+      close(unit=22)
+      close(unit=23)
+      close(unit=24)
+      close(unit=25)
+      close(unit=26)
+      close(unit=27)
+
+CCC   Next read and interpolate the unlike pair Coulomb corrections:
+
+      If(ALICE .eq. 1) then
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpm_06.dat' 
+       open(unit=31,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpm_08.dat' 
+       open(unit=32,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpm_10.dat' 
+       open(unit=33,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpm_12.dat' 
+       open(unit=34,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpm_14.dat' 
+       open(unit=35,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpm_16.dat' 
+       open(unit=36,type='old',access='sequential',
+     1       name=FILNAM)
+
+        FILNAM=CHROOT(1:LNROOT)//'/data/cpm_18.dat' 
+       open(unit=37,type='old',access='sequential',
+     1       name=FILNAM)
+    
+      else
+        open(unit=31,type='old',access='sequential',
+     1       name='cpm_06.dat')
+        open(unit=32,type='old',access='sequential',
+     1       name='cpm_08.dat')
+        open(unit=33,type='old',access='sequential',
+     1       name='cpm_10.dat')
+        open(unit=34,type='old',access='sequential',
+     1       name='cpm_12.dat')
+        open(unit=35,type='old',access='sequential',
+     1       name='cpm_14.dat')
+        open(unit=36,type='old',access='sequential',
+     1       name='cpm_16.dat')
+        open(unit=37,type='old',access='sequential',
+     1       name='cpm_18.dat')
+      EndIf
+      
+      do i = 1,max_c2_coul
+         do j = 1,ncoulradsteps
+            read(30+j,*) q_coul(i), function(j)
+         end do
+         Call AliHbtp_interp(coulradmin,coulradmax,coulradstep, 
+     1        ncoulradsteps,function,20,Q0,c2_coul_unlike(i))
+      end do
+
+      close(unit=31)
+      close(unit=32)
+      close(unit=33)
+      close(unit=34)
+      close(unit=35)
+      close(unit=36)
+      close(unit=37)
+
+CCC   Convert the input q values which are in MeV/c, to GeV/c:
+
+      do i = 1,max_c2_coul
+         q_coul(i) = 0.001*q_coul(i)
+      end do
+
+      end if   
+
+
+C----------------------------
+      ELSE IF(mode.eq.7) THEN
+C----------------------------
+
+CCC   Read next event from 'event_text.in', load accepted tracks into 'trk'
+CCC   data structure using the flag information in the file
+CCC   'event_tracks.select', copy contents of 'event_text.in' and
+CCC   'event_tracks.select', for this one event only, into temporary files
+CCC   'event_text_aux.in' and 'event_tracks_aux.select', respectively.
+C
+C     For this mode to run successfully the calling program must:
+C       (1) initially set the event_line_counter = 0
+C       (2) open the 'event_text.in' and 'event_tracks.select' files
+C           as units 2 and 4, respectively.
+C       (3) Close units 2 and 4 when finished.
+
+CCC   Initialize accepted track counters for this new event:
+
+      track_counter   = 0     ! Counts all accepted tracks
+      track_counter_1 = 0     ! Counts all accepted tracks of type pid(1)
+      track_counter_2 = 0     ! Counts all accepted tracks of type pid(2)
+
+      If(ALICE .eq. 1) Then
+         Call AliHbtp_GetNumberTracks(ntracks)
+         do i = 1,ntracks
+            Call AliHbtp_GetTrack(i,flag,px,py,pz,ge_pid)
+            eg_pid = ge_pid
+            if(flag.eq.flag4) then
+         track_counter = track_counter + 1
+
+         if(eg_pid.eq.pid(1) .and. pid(1).gt.0) then
+            track_counter_1 = track_counter_1 + 1
+         end if
+
+         if(eg_pid.eq.pid(2) .and. pid(2).gt.0) then
+            track_counter_2 = track_counter_2 + 1
+         end if
+
+         mass = part_mass(eg_pid)
+         Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+         trk_ge_pid(track_counter)        = eg_pid
+         trk_px(track_counter)            = px
+         trk_py(track_counter)            = py
+         trk_pz(track_counter)            = pz
+         trk_id(track_counter)            = track_counter
+         trk_start_vertex(track_counter)  = 0
+         trk_stop_vertex(track_counter)   = 0
+         trk_event_line(track_counter)    = 0
+         trk_flag(track_counter)          = 0
+         trk_px_sec(track_counter)        = 0
+         trk_py_sec(track_counter)        = 0
+         trk_pz_sec(track_counter)        = 0
+         trk_sector(track_counter)        = 0
+         trk_out_flag(track_counter)      = 0
+         trk_merge_flag(track_counter)    = 0
+         trk_E(track_counter)             = E
+         trk_pt(track_counter)            = pt
+         trk_phi(track_counter)           = phi
+         trk_eta(track_counter)           = eta
+        end if
+       end do
+         n_part_1_trk   = track_counter_1
+         n_part_2_trk   = track_counter_2
+         n_part_tot_trk = track_counter
+
+      Else If(ALICE .eq. 0) Then
+
+CCC   Open temporary files:
+
+      open(unit=12,status='unknown',access='sequential',
+     1     name='event_text_aux.in')
+      open(unit=14,status='unknown',access='sequential',
+     1     name='event_tracks_aux.select')
+
+100   read(4,11,err=101,end=102) flag
+      event_line_counter = event_line_counter + 1
+      write(14,11) flag
+      if(flag.eq.1) then
+         read(2,10,err=103,end=102) comment_event_label
+         write(12,10) comment_event_label
+      else if(flag .eq. 2) then
+         read(2,10,err=103,end=102) vertex_label
+         write(12,10) vertex_label
+      else if(flag .eq. 3) then
+         read(2,10,err=103,end=102) comment_event_label
+         write(12,10) comment_event_label
+      else if(flag .eq. 5) then
+         read(2,10,err=103,end=102) gener_label
+         write(12,10) gener_label
+      else if(flag .eq. 4) then
+         read(2,41) ge_pid,px,py,pz,tid,start_v,stop_v,eg_pid
+         write(12,41) ge_pid,px,py,pz,tid,start_v,stop_v,eg_pid
+
+CCC   Check if the 'event_text.in' file includes non-zero PID
+CCC   values for the variable 'eg_pid'.  If this is zero, then
+CCC   use the ge_pid value.
+         if(eg_pid.eq.0 .and. ge_pid.ne.0) eg_pid = ge_pid
+
+         track_counter = track_counter + 1
+
+         if(eg_pid.eq.pid(1) .and. pid(1).gt.0) then
+            track_counter_1 = track_counter_1 + 1
+         end if
+
+         if(eg_pid.eq.pid(2) .and. pid(2).gt.0) then
+            track_counter_2 = track_counter_2 + 1
+         end if
+
+         mass = part_mass(eg_pid)
+         Call Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,1)
+         trk_ge_pid(track_counter)        = eg_pid
+         trk_px(track_counter)            = px
+         trk_py(track_counter)            = py
+         trk_pz(track_counter)            = pz
+         trk_id(track_counter)            = track_counter
+         trk_start_vertex(track_counter)  = start_v
+         trk_stop_vertex(track_counter)   = stop_v
+         trk_event_line(track_counter)    = event_line_counter
+         trk_flag(track_counter)          = 0
+         trk_px_sec(track_counter)        = 0
+         trk_py_sec(track_counter)        = 0
+         trk_pz_sec(track_counter)        = 0
+         trk_sector(track_counter)        = 0
+         trk_out_flag(track_counter)      = 0
+         trk_merge_flag(track_counter)    = 0
+         trk_E(track_counter)             = E
+         trk_pt(track_counter)            = pt
+         trk_phi(track_counter)           = phi
+         trk_eta(track_counter)           = eta
+      else
+         read(2,10,err=103,end=102) comment_event_label
+         write(12,10) comment_event_label
+      end if
+
+      if(flag.ne.1) then
+         go to 100   ! Return to S.N. 100 and read next record in file
+      else if(flag.eq.1) then
+         n_part_1_trk   = track_counter_1
+         n_part_2_trk   = track_counter_2
+         n_part_tot_trk = track_counter
+      end if
+
+102   Close(unit=12)
+      Close(unit=14)
+      Return
+101   write(7,104)
+104   Format(5x,'Read error from file event_tracks.select for mode=7',
+     1       ' - STOP')
+      Stop
+103   write(7,105)
+105   Format(5x,'Read error from file event_text.in for mode=7',
+     1       ' - STOP')
+      Stop
+
+      End If  !  ALICE Data I/O Option
+
+C----------------------------
+      ELSE IF(mode.eq.8) THEN
+C----------------------------
+
+CCC   Read contents of 'event_text_aux.in' using the flag values in
+CCC   tmp. file 'event_tracks_aux.select' and copy this into the final
+CCC   output event file, 'event_hbt_text.out', where the momentum values
+CCC   of the accepted tracks in the initial input event file are replaced
+CCC   with the adjusted/correlated values obtained from the 'trk' table.
+C
+C     For this to work successfully the calling program must:
+C      (1) initially set the event_line_counter = 0
+C      (2) open the 'event_hbt_text.out' file as unit = 10
+C      (3) Close unit 10 when finished
+
+CCC   Initialize accepted track counters:
+
+      track_counter = 0
+
+      If(ALICE .eq. 1) Then
+         Call AliHbtp_GetNumberTracks(ntracks)
+         do i = 1,ntracks
+            Call AliHbtp_GetTrack(i,flag,px,py,pz,ge_pid)
+            if(flag.eq.flag4) then
+              track_counter = track_counter + 1
+              if(trk_accep .ge. 1.000  .or. (trk_accep .lt. 1.00
+     1           .and. hbtpran(irand) .le. trk_accep)) then
+C                 write(*,*) '  FFF: 3 calling PutTrack i = ',i
+                 Call AliHbtp_PutTrack(i,flag,
+     1                trk_px(track_counter),
+     2                trk_py(track_counter),
+     3                trk_pz(track_counter),
+     4                ge_pid)
+              end if
+            end if
+         end do
+
+      Else If(ALICE .eq. 0) Then
+
+CCC   Open temporary, auxiliary files:
+
+      open(unit=12,type='old',access='sequential',
+     1     name='event_text_aux.in')
+      open(unit=14,type='old',access='sequential',
+     1     name='event_tracks_aux.select')
+
+120   read(14,11,err=121,end=122) flag
+      file10_line_counter = file10_line_counter + 1
+      if(flag.eq.1) then
+         read(12,10,err=123,end=122) comment_event_label
+         write(10,10) comment_event_label
+      else if(flag .eq. 2) then
+         read(12,10,err=123,end=122) vertex_label
+         write(10,10) vertex_label
+      else if(flag .eq. 3) then
+         read(12,10,err=123,end=122) comment_event_label
+         write(10,10) comment_event_label
+      else if(flag .eq. 5) then
+         read(12,10,err=123,end=122) gener_label
+         write(10,10) gener_label
+      else if(flag .eq. 4) then
+         read(12,41,err=123,end=122)
+     1      ge_pid,px,py,pz,tid,start_v,stop_v,eg_pid
+         track_counter = track_counter + 1
+         if(tid.eq.0) tid = trk_id(track_counter)
+         if(trk_event_line(track_counter).eq.file10_line_counter)then
+            if(trk_accep .ge. 1.000  .or. (trk_accep .lt. 1.00
+     1         .and. hbtpran(irand) .le. trk_accep)) then
+            write(10,841)ge_pid                   ,
+     1                   trk_px(track_counter)    ,
+     2                   trk_py(track_counter)    ,
+     3                   trk_pz(track_counter)    ,
+     4                   tid                      ,
+     5                   start_v                  ,
+     6                   stop_v                   ,
+     7                   trk_ge_pid(track_counter)
+841         Format('TRACK:',1x,I6,3(1x,G12.5),4(1x,I6))
+            end if
+         else
+            write(7,127)
+            write(7,126) track_counter, trk_event_line(track_counter),
+     1                file10_line_counter
+127         Format(5x,'Track table rows and Event file line count ',
+     1          'out-of-synch. - STOP')
+126         Format(5x,'track_counter, trk().event_line,',
+     1          'file10_line_counter = ',3I10)
+            Stop
+         end if
+      else
+         read(12,10,err=123,end=122) comment_event_label
+         write(10,10) comment_event_label
+      end if
+
+      if(flag .ne. 1) go to 120  !  Return to S.N. 120 and read next record
+
+122   Close(unit=12,status='delete')
+      Close(unit=14,status='delete')
+      Return
+121   write(7,124)
+124   Format(5x,'Read error from file event_tracks_aux.select',
+     1       ' for mode = 8 - STOP')
+      Stop
+123   write(7,125)
+125   Format(5x,'Read error from file event_text_aux.in',
+     1       ' for mode = 8 - STOP')
+      Stop
+     
+      End If  !  ALICE Data I/O Option
+
+C-----------------
+      END IF     ! End of read_data mode selection options
+C-----------------
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+
+      subroutine getref_hist
+      implicit none
+
+CCC   This subroutine controls the reading or calculation and output
+CCC   of the several reference histograms.  These include:
+CCC      (a) the one-body {pt,phi,eta} 1D distributions for 1 or 2
+CCC          particle ID types.
+CCC      (b) the two-body pair-wise histograms for like and unlike
+CCC          pairs; for 1D and/or 3D fine mesh and 3D coarse mesh
+CCC          distributions.
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+      Include 'common_particle.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,ipt,iphi,ieta,sign_toggle
+
+      if(ref_control .eq. 1) then
+
+CCC   read pair and one-body reference histograms:
+         Call read_data(3)
+      else if(ref_control .eq. 2) then
+
+CCC   calculate the pair and one-body histograms:
+CCC   Open event and flag files:
+
+      If(ALICE .eq. 0) Then
+         open(unit=2,type='old',access='sequential',
+     1        name='event_text.in')
+         open(unit=4,type='old',access='sequential',
+     1        name='event_tracks.select')
+      End If
+
+CCC   Initialize counters:
+
+         n_part_used_1_ref    = 0
+         n_part_used_2_ref    = 0
+         num_pairs_like_ref   = 0
+         num_pairs_unlike_ref = 0
+         event_line_counter   = 0
+
+CCC   Read event header lines (no tracks are in this part):
+      If(ALICE .eq. 0) Then
+         Call read_data(4)
+      End If
+
+CCC   Set toggle switch to alternate between loading event tracks into
+CCC   table 'trk' and table 'trk2':
+         sign_toggle = 1
+
+CCC   Start Event Loop:
+
+         do i = 1,n_events
+           If(ALICE .eq. 1) Then
+              Call AliHbtp_SetActiveEventNumber(i)
+           End If
+           if(sign_toggle .eq. 1) then   ! Put tracks into 'trk'
+             Call read_data(4)
+             Call tindex(1,0)
+             Call stm_build(1,0,0)
+             if(pid(1) .gt. 0) then
+               Call histog1(1,0,1,pid(1),0.0,0.0,0.0)
+               n_part_used_1_ref = n_part_used_1_ref + n_part_used_1_trk
+
+               do ipt = 1,n_pt_bins
+               href1_pt_1(ipt) = href1_pt_1(ipt) + hist1_pt_1(ipt)
+               end do
+
+               do iphi = 1,n_phi_bins
+               href1_phi_1(iphi) = href1_phi_1(iphi) + hist1_phi_1(iphi)
+               end do
+
+               do ieta = 1,n_eta_bins
+               href1_eta_1(ieta) = href1_eta_1(ieta) + hist1_eta_1(ieta)
+               end do
+             end if
+
+             if(pid(2) .gt. 0) then
+               Call histog1(1,0,2,pid(2),0.0,0.0,0.0)
+               n_part_used_2_ref = n_part_used_2_ref + n_part_used_2_trk
+
+               do ipt = 1,n_pt_bins
+               href1_pt_2(ipt) = href1_pt_2(ipt) + hist1_pt_2(ipt)
+               end do
+
+               do iphi = 1,n_phi_bins
+               href1_phi_2(iphi) = href1_phi_2(iphi) + hist1_phi_2(iphi)
+               end do
+
+               do ieta = 1,n_eta_bins
+               href1_eta_2(ieta) = href1_eta_2(ieta) + hist1_eta_2(ieta)
+               end do
+             end if
+
+           else if(sign_toggle .eq. (-1)) then  ! Put tracks into 'trk2'
+             Call read_data(5)
+             Call tindex(2,0)
+             Call stm_build(2,0,0)
+             if(pid(1) .gt. 0) then
+               Call histog1(4,0,1,pid(1),0.0,0.0,0.0)
+               n_part_used_1_ref = n_part_used_1_ref +n_part_used_1_trk2
+
+               do ipt = 1,n_pt_bins
+               href1_pt_1(ipt) = href1_pt_1(ipt) + hist1_pt_1(ipt)
+               end do
+
+               do iphi = 1,n_phi_bins
+               href1_phi_1(iphi) = href1_phi_1(iphi) + hist1_phi_1(iphi)
+               end do
+
+               do ieta = 1,n_eta_bins
+               href1_eta_1(ieta) = href1_eta_1(ieta) + hist1_eta_1(ieta)
+               end do
+             end if
+
+             if(pid(2) .gt. 0) then
+               Call histog1(4,0,2,pid(2),0.0,0.0,0.0)
+               n_part_used_2_ref = n_part_used_2_ref +n_part_used_2_trk2
+
+               do ipt = 1,n_pt_bins
+               href1_pt_2(ipt) = href1_pt_2(ipt) + hist1_pt_2(ipt)
+               end do
+
+               do iphi = 1,n_phi_bins
+               href1_phi_2(iphi) = href1_phi_2(iphi) + hist1_phi_2(iphi)
+               end do
+
+               do ieta = 1,n_eta_bins
+               href1_eta_2(ieta) = href1_eta_2(ieta) + hist1_eta_2(ieta)
+               end do
+             end if
+
+           end if   !  End read and load to trk or trk2 option
+
+           sign_toggle = -sign_toggle
+
+           if(i .gt. 1) then    !  Compute 2-body reference histograms
+              Call histog2(4,0,0,0,0,0.0,0.0,0.0,0.0)
+              num_pairs_like_ref = num_pairs_like_ref
+     1           + n_part_used_1_trk * n_part_used_1_trk2
+     2           + n_part_used_2_trk * n_part_used_2_trk2
+              num_pairs_unlike_ref = num_pairs_unlike_ref
+     1           + n_part_used_1_trk * n_part_used_2_trk2
+     2           + n_part_used_2_trk * n_part_used_1_trk2
+           end if
+
+        end do   !  End of Event Loop
+
+CCC   Write out the pair and one-body reference Histograms:
+      Call write_data(2,0)
+
+      If(ALICE .eq. 0) Then
+      Close(unit=2)
+      Close(unit=4)
+      End If
+
+      end if  !  End Reference Histogram read/calculate option
+
+      Return
+      END
+
+C----------------------------------------------------------------------
+
+
+      subroutine AliHbtp_interp(rmin,rmax,rstep,nrsteps,function,
+     1                          ndim,r,answer)
+      implicit none
+
+CCC   This routine interpolates the function values and puts the result
+CCC   into 'answer'.  It uses 2,3 or 4 mesh points which must be equally
+CCC   spaced.  The method uses the Lagrange interpolation formulas given
+CCC   in Abramowitz and Stegun, ``Handbook of Mathematical Functions,''
+CCC   (Dover Publications, New York, 1970); pages 878-879.
+
+CCC   Definition of Variables in the Argument List:
+
+CCC   rmin     = lower limit of independent variable for input function
+CCC   rmax     = upper limit of independent variable for input function
+CCC   rstep    = step size of independent variable
+CCC   nrsteps  = (redundant) # of input steps
+CCC   function(ndim) = Array of function values to be interpolated
+CCC   ndim     = array dimension size in calling program
+CCC   r        = coordinate value of independent variable where interpolation
+CCC              is needed.
+CCC   answer   = interpolated value
+
+CCC   The algorithm will use the maximum number of points in the
+CCC   interpolation, up to a maximum of 4
+
+CCC   If the requested coordinate value, r, is out-of-range, then
+CCC   'answer' is returned with a 0.0 value.
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 ndim, nrsteps, ik
+
+      real*4 rmin,rmax,rstep,r,answer,rshift,p
+      real*4 function(ndim),w1,w2,w3,w4
+
+CCC   Check Mesh:
+
+      if(abs(((rmax-rmin)/float(nrsteps-1))-rstep).gt.0.00001) then
+         write(7,10) rmin,rmax,rstep,nrsteps
+10       Format(5x,'Interp mesh inconsistent:',3E12.5,I5,
+     1          ' - STOP')
+      Return
+      end if
+
+CCC   Check range:
+     
+      if(r .lt. rmin .or. r .gt. rmax) then
+         write(7,11) rmin,rmax,r
+11       Format(5x,'Interp called with r out-of-range =',3E12.5)
+         answer = 0.0
+         Return
+      end if
+
+CCC   Begin interpolation:
+
+      if(nrsteps .eq. 2) then
+         p = (r - rmin)/rstep
+         answer = (1.0 - p)*function(1) + p*function(2)
+      else if(nrsteps .eq. 3) then
+         p = (r - (rmin + rstep))/rstep
+         answer = 0.5*p*(p-1.0)*function(1) + (1.0 - p*p)
+     1            *function(2) + 0.5*p*(p+1.0)*function(3)
+      else if(nrsteps .ge. 4) then
+         rshift = r - rmin
+
+         if(rshift .le. rstep) then
+            ik = 2
+            p = (rshift - rstep)/rstep
+         else if(rshift .ge. (rmax - rstep - rmin)) then
+            ik = nrsteps - 2
+            p = (rshift - (rmax - rmin - 2.0*rstep))/rstep
+         else
+            ik = int(rshift/rstep + 1.000001)
+            if(ik .le. 1) ik = 2
+            if(ik .ge. (nrsteps-1)) ik = nrsteps - 2
+            p = (rshift - float(ik-1)*rstep)/rstep
+         end if
+
+         w1 = -p*(p-1.0)*(p-2.0)/6.0
+         w2 = (p*p-1.0)*(p-2.0)/2.0
+         w3 = -p*(p+1.0)*(p-2.0)/2.0
+         w4 = p*(p*p-1.0)/6.0
+
+         answer = w1*function(ik-1) + w2*function(ik)
+     1          + w3*function(ik+1) + w4*function(ik+2)
+      end if  !  End # interplation points option
+
+      Return
+      END
+
+C--------------------------------------------------------------------
+
+
+      subroutine Hbtp_particle_prop
+      implicit none
+
+CCC   Fill particle properties table /particle/ with Geant 3 particle ID
+CCC   numbers, charge (in units of |e|), mass in GeV/c**2 and lifetime
+CCC   in seconds.  See the Geant 3.15 Manual User's Guide, pages: CONS
+CCC   300-1 and -2.
+
+      Include 'common_particle.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i
+
+      do i = 1,part_maxlen
+      part_id(i) = i
+      end do
+
+CCC   Set Particle Masses:
+
+      part_mass( 1) = 0.0                   ! Gamma
+      part_mass( 2) = 0.00051099906         ! Positron
+      part_mass( 3) = 0.00051099906         ! Electron
+      part_mass( 4) = 0.0                   ! Neutrino
+      part_mass( 5) = 0.105658389           ! Muon+
+      part_mass( 6) = 0.105658389           ! Muon-
+      part_mass( 7) = 0.1349743             ! Pion0
+      part_mass( 8) = 0.1395679             ! Pion+
+      part_mass( 9) = 0.1395679             ! Pion-
+      part_mass(10) = 0.497671              ! Kaon 0 long
+      part_mass(11) = 0.493646              ! Kaon+
+      part_mass(12) = 0.493646              ! Kaon-
+      part_mass(13) = 0.93956563            ! Neutron
+      part_mass(14) = 0.93827231            ! Proton
+      part_mass(15) = 0.93827231            ! Antiproton
+      part_mass(16) = 0.497671              ! Kaon 0 short
+      part_mass(17) = 0.54745               ! Eta
+      part_mass(18) = 1.11563               ! Lambda
+      part_mass(19) = 1.18937               ! Sigma+
+      part_mass(20) = 1.19255               ! Sigma0
+      part_mass(21) = 1.197465              ! Sigma-
+      part_mass(22) = 1.31485               ! Xi 0
+      part_mass(23) = 1.32133               ! Xi -
+      part_mass(24) = 1.67243               ! Omega
+      part_mass(25) = 0.93956563            ! Antineutron
+      part_mass(26) = 1.11563               ! Antilambda
+      part_mass(27) = 1.18937               ! Anti-Sigma -
+      part_mass(28) = 1.19255               ! Anti-Sigma 0
+      part_mass(29) = 1.197465              ! Anti-Sigma +
+      part_mass(30) = 1.31485               ! AntiXi 0
+      part_mass(31) = 1.32133               ! AntiXi +
+      part_mass(32) = 1.67243               ! Anti-Omega +
+      part_mass(33) = 0.0
+      part_mass(34) = 0.0
+      part_mass(35) = 0.0
+      part_mass(36) = 0.0
+      part_mass(37) = 0.0
+      part_mass(38) = 0.0
+      part_mass(39) = 0.0
+      part_mass(40) = 0.0
+      part_mass(41) = 0.0
+      part_mass(42) = 0.0
+      part_mass(43) = 0.0
+      part_mass(44) = 0.0
+      part_mass(45) = 1.875613              ! Deuteron
+      part_mass(46) = 2.80925               ! Triton
+      part_mass(47) = 3.727417              ! Alpha
+      part_mass(48) = 0.0                   ! Geantino (Fake particle)
+      part_mass(49) = 2.80923               ! He3
+      part_mass(50) = 0.0                   ! Cerenkov (Fake particle)
+
+CCC   Set Particle Charge:
+
+      part_charge( 1) =  0      ! Gamma
+      part_charge( 2) =  1      ! Positron
+      part_charge( 3) = -1      ! Electron
+      part_charge( 4) =  0      ! Neutrino
+      part_charge( 5) =  1      ! Muon+
+      part_charge( 6) = -1      ! Muon-
+      part_charge( 7) =  0      ! Pion0
+      part_charge( 8) =  1      ! Pion+
+      part_charge( 9) = -1      ! Pion-
+      part_charge(10) =  0      ! Kaon 0 long
+      part_charge(11) =  1      ! Kaon+
+      part_charge(12) = -1      ! Kaon-
+      part_charge(13) =  0      ! Neutron
+      part_charge(14) =  1      ! Proton
+      part_charge(15) = -1      ! Antiproton
+      part_charge(16) =  0      ! Kaon 0 short
+      part_charge(17) =  0      ! Eta
+      part_charge(18) =  0      ! Lambda
+      part_charge(19) =  1      ! Sigma+
+      part_charge(20) =  0      ! Sigma0
+      part_charge(21) = -1      ! Sigma-
+      part_charge(22) =  0      ! Xi 0
+      part_charge(23) = -1      ! Xi -
+      part_charge(24) = -1      ! Omega
+      part_charge(25) =  0      ! Antineutron
+      part_charge(26) =  0      ! Antilambda
+      part_charge(27) = -1      ! Anti-Sigma -
+      part_charge(28) =  0      ! Anti-Sigma 0
+      part_charge(29) =  1      ! Anti-Sigma +
+      part_charge(30) =  0      ! AntiXi 0
+      part_charge(31) =  1      ! AntiXi +
+      part_charge(32) =  1      ! Anti-Omega +
+      part_charge(33) =  0
+      part_charge(34) =  0
+      part_charge(35) =  0
+      part_charge(36) =  0
+      part_charge(37) =  0
+      part_charge(38) =  0
+      part_charge(39) =  0
+      part_charge(40) =  0
+      part_charge(41) =  0
+      part_charge(42) =  0
+      part_charge(43) =  0
+      part_charge(44) =  0
+      part_charge(45) =  1      ! Deuteron
+      part_charge(46) =  1      ! Triton
+      part_charge(47) =  2      ! Alpha
+      part_charge(48) =  0      ! Geantino (Fake particle)
+      part_charge(49) =  2      ! He3
+      part_charge(50) =  0      ! Cerenkov (Fake particle)
+
+CCC   Set Particle Lifetimes:
+
+      part_lifetime( 1) = 1.0E+30       ! Gamma
+      part_lifetime( 2) = 1.0E+30       ! Positron
+      part_lifetime( 3) = 1.0E+30       ! Electron
+      part_lifetime( 4) = 1.0E+30       ! Neutrino
+      part_lifetime( 5) = 2.19703E-06   ! Muon+
+      part_lifetime( 6) = 2.19703E-06   ! Muon-
+      part_lifetime( 7) = 8.4E-17       ! Pion0
+      part_lifetime( 8) = 2.603E-08     ! Pion+
+      part_lifetime( 9) = 2.603E-08     ! Pion-
+      part_lifetime(10) = 5.16E-08      ! Kaon 0 long
+      part_lifetime(11) = 1.237E-08     ! Kaon+
+      part_lifetime(12) = 1.237E-08     ! Kaon-
+      part_lifetime(13) = 889.1         ! Neutron
+      part_lifetime(14) = 1.0E+30       ! Proton
+      part_lifetime(15) = 1.0E+30       ! Antiproton
+      part_lifetime(16) = 8.922E-11     ! Kaon 0 short
+      part_lifetime(17) = 5.53085E-19   ! Eta
+      part_lifetime(18) = 2.632E-10     ! Lambda
+      part_lifetime(19) = 7.99E-11      ! Sigma+
+      part_lifetime(20) = 7.40E-20      ! Sigma0
+      part_lifetime(21) = 1.479E-10     ! Sigma-
+      part_lifetime(22) = 2.90E-10      ! Xi 0
+      part_lifetime(23) = 1.639E-10     ! Xi -
+      part_lifetime(24) = 8.22E-11      ! Omega
+      part_lifetime(25) = 889.1         ! Antineutron
+      part_lifetime(26) = 2.632E-10     ! Antilambda
+      part_lifetime(27) = 7.99E-11      ! Anti-Sigma -
+      part_lifetime(28) = 7.40E-20      ! Anti-Sigma 0
+      part_lifetime(29) = 1.479E-10     ! Anti-Sigma +
+      part_lifetime(30) = 2.90E-10      ! AntiXi 0
+      part_lifetime(31) = 1.639E-10     ! AntiXi +
+      part_lifetime(32) = 8.22E-11      ! Anti-Omega +
+      part_lifetime(33) = 0.0
+      part_lifetime(34) = 0.0
+      part_lifetime(35) = 0.0
+      part_lifetime(36) = 0.0
+      part_lifetime(37) = 0.0
+      part_lifetime(38) = 0.0
+      part_lifetime(39) = 0.0
+      part_lifetime(40) = 0.0
+      part_lifetime(41) = 0.0
+      part_lifetime(42) = 0.0
+      part_lifetime(43) = 0.0
+      part_lifetime(44) = 0.0
+      part_lifetime(45) = 1.0E+30       ! Deuteron
+      part_lifetime(46) = 1.0E+30       ! Triton
+      part_lifetime(47) = 1.0E+30       ! Alpha
+      part_lifetime(48) = 1.0E+30       ! Geantino (Fake particle)
+      part_lifetime(49) = 1.0E+30       ! He3
+      part_lifetime(50) = 1.0E+30       ! Cerenkov (Fake particle)
+
+      Return
+      END
+
+C----------------------------------------------------------------
+
+
+      subroutine correl_model
+      implicit none
+
+CCC   This subroutine computes the requested 2-body model correlation
+CCC   function which is to be fitted by the track adjustment procedure.
+CCC   The model values are calculated on the requested fine and coarse
+CCC   mesh grid in momentum space.  The model values are computed at the
+CCC   mid point of each 1D bin or at the center of each 3D cell.  This
+CCC   could be refined at a later date to correspond to the integral of
+CCC   the model function over the bin width (cell volume) divided by the
+CCC   the bin width (cell volume).
+
+C     The model includes the following options which are selected by the
+C     'switch*' parameters in common/parameters/:
+C
+C        switch_1d:          1D model as function of either Qinvar, Qtotal
+C                            or Q-vector
+C        switch_3d:          3D model as function of either the Bertsch-Pratt
+C                            side-out-long kinematics (but no cross term) or
+C                            the Yano-Koonin-Podgoretski perp-parallel-time
+C                            kinematics.
+C        switch_type:        Like and/or Unlike particles
+C        switch_coherence:   Purely incoherent source or a mixed incoherent-
+C                            coherent source.
+C        switch_coulomb:     Either (a) no Coulomb correction, (b) Gamow
+C                            factor, (c) NA35 parametrization, or (d) Pratt
+C                            Coulomb wave function integration for finite
+C                            size, spherical source.
+C        switch_fermi_bose:  Fermion or boson identical pairs.
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_correlations.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,j,k
+
+      real*4 R_1dsq, Rsidesq, Routsq, Rlongsq
+      real*4 Rperpsq, Rparallelsq, R0sq
+      real*4 sqrtlambda,fermi_bose_sign,coulomb_factor,coherence_fac
+      real*4 q,q1,q2,q3
+      real*4 b,b1,b2,b3
+      real*4 massavg
+
+CCC   Set Constants:
+
+      sqrtlambda  = sqrt(abs(lambda))
+      R_1dsq      = ((R_1d     /hbc)**2)/2.0
+      Rsidesq     = ((Rside    /hbc)**2)/2.0
+      Routsq      = ((Rout     /hbc)**2)/2.0
+      Rlongsq     = ((Rlong    /hbc)**2)/2.0
+      Rperpsq     = ((Rperp    /hbc)**2)/2.0
+      Rparallelsq = ((Rparallel/hbc)**2)/2.0
+      R0sq        = ((R0       /hbc)**2)/2.0
+
+      fermi_bose_sign = float(switch_fermi_bose)
+      coherence_fac   = switch_coherence*2.0*sqrtlambda*
+     1                  (1.0 - sqrtlambda)
+
+CCC   Determine average particle pair mass for Coulomb correction:
+
+      massavg = 0.14
+      if(mass1.eq.0.0 .and. mass2.gt.0.0) massavg = mass2
+      if(mass1.gt.0.0 .and. mass2.eq.0.0) massavg = mass1
+      if(mass1.gt.0.0 .and. mass2.gt.0.0) massavg = 0.5*(mass1+mass2)
+    
+CCC   Compute 1D correlation model arrays:
+
+      If(switch_1d .ge. 1) then
+        If(n_1d_fine .gt. 0) then        ! Fill the 1D fine mesh bins
+          q = -0.5*binsize_1d_fine
+          do i = 1,n_1d_fine
+            q = q + binsize_1d_fine
+            b = exp(-q*q*R_1dsq)
+
+            if(switch_type.eq.1 .or. switch_type.eq.3) then
+              c2mod_like_1d(i) = 1.0 + fermi_bose_sign*(lambda
+     1                         *b*b + coherence_fac*b)
+              if(switch_coulomb.eq.0) then
+                coulomb_factor = 1.0
+              else if(switch_coulomb.gt.0) then
+                Call coulomb(switch_coulomb,q,1,massavg,Q0,
+     1                       coulomb_factor)
+              end if
+              c2mod_like_1d(i) = coulomb_factor*c2mod_like_1d(i)
+            end if
+
+            if(switch_type.eq.2 .or. switch_type.eq.3) then
+             c2mod_unlike_1d(i) = 1.0 
+             if(switch_coulomb.eq.0) then
+               coulomb_factor = 1.0
+             else if(switch_coulomb.gt.0) then
+               Call coulomb(switch_coulomb,q,-1,massavg,Q0,
+     1                      coulomb_factor)
+             end if
+             c2mod_unlike_1d(i) = coulomb_factor*c2mod_unlike_1d(i)
+            end if
+
+          end do    ! End of 1D fine mesh filling do-loop
+        end if      ! End of 1D fine mesh option
+
+        If(n_1d_coarse .gt. 0) then      ! Fill the 1D coarse mesh bins
+          q = qmid_1d -0.5*binsize_1d_coarse
+          do i = n_1d_fine + 1, n_1d_total
+            q = q + binsize_1d_coarse
+            b = exp(-q*q*R_1dsq)
+
+            if(switch_type.eq.1 .or. switch_type.eq.3) then
+              c2mod_like_1d(i) = 1.0 + fermi_bose_sign*(lambda
+     1                         *b*b + coherence_fac*b)
+              if(switch_coulomb.eq.0) then
+                coulomb_factor = 1.0
+              else if(switch_coulomb.gt.0) then
+                Call coulomb(switch_coulomb,q,1,massavg,Q0,
+     1                       coulomb_factor)
+              end if
+              c2mod_like_1d(i) = coulomb_factor*c2mod_like_1d(i)
+            end if
+
+            if(switch_type.eq.2 .or. switch_type.eq.3) then
+             c2mod_unlike_1d(i) = 1.0 
+             if(switch_coulomb.eq.0) then
+               coulomb_factor = 1.0
+             else if(switch_coulomb.gt.0) then
+               Call coulomb(switch_coulomb,q,-1,massavg,Q0,
+     1                      coulomb_factor)
+             end if
+             c2mod_unlike_1d(i) = coulomb_factor*c2mod_unlike_1d(i)
+            end if
+
+          end do    ! End of 1D coarse mesh filling do-loop
+        end if      ! End of 1D coarse mesh option
+      end if        ! End of 1D option
+
+CCC   Compute 3D correlation model arrays:
+
+      If(switch_3d .ge. 1) Then
+       If(n_3d_fine .gt. 0) then     !  Fill the 3D fine mesh bins
+        q1 = -0.5*binsize_3d_fine
+        do i = 1,n_3d_fine
+         q1 = q1 + binsize_3d_fine
+         if(switch_3d.eq.1) b1=exp(-q1*q1*Rsidesq)
+         if(switch_3d.eq.2) b1=exp(-q1*q1*Rperpsq)
+
+          q2 = -0.5*binsize_3d_fine
+          do j = 1,n_3d_fine
+           q2 = q2 + binsize_3d_fine
+           if(switch_3d.eq.1) b2=exp(-q2*q2*Routsq)
+           if(switch_3d.eq.2) b2=exp(-q2*q2*Rparallelsq)
+
+            q3 = -0.5*binsize_3d_fine
+            do k = 1,n_3d_fine
+             q3 = q3 + binsize_3d_fine
+             if(switch_3d.eq.1) b3=exp(-q3*q3*Rlongsq)
+             if(switch_3d.eq.2) b3=exp(-q3*q3*R0sq)
+
+             b = b1*b2*b3
+             if(switch_3d.eq.1) q = sqrt(q1*q1+q2*q2+q3*q3)
+             if(switch_3d.eq.2) q = sqrt(q1*q1+q2*q2)
+
+             if(switch_type.eq.1 .or. switch_type.eq.3) then
+              c2mod_like_3d_fine(i,j,k) = 1.0 + fermi_bose_sign*(lambda
+     1                         *b*b + coherence_fac*b)
+              if(switch_coulomb.eq.0) then
+                coulomb_factor = 1.0
+              else if(switch_coulomb.gt.0) then
+                Call coulomb(switch_coulomb,q,1,massavg,Q0,
+     1                       coulomb_factor)
+              end if
+              c2mod_like_3d_fine(i,j,k) =
+     1           coulomb_factor*c2mod_like_3d_fine(i,j,k)
+             end if
+
+             if(switch_type.eq.2 .or. switch_type.eq.3) then
+              c2mod_unlike_3d_fine(i,j,k) = 1.0 
+              if(switch_coulomb.eq.0) then
+                coulomb_factor = 1.0
+              else if(switch_coulomb.gt.0) then
+                Call coulomb(switch_coulomb,q,-1,massavg,Q0,
+     1                       coulomb_factor)
+              end if
+              c2mod_unlike_3d_fine(i,j,k) =
+     1           coulomb_factor*c2mod_unlike_3d_fine(i,j,k)
+             end if
+
+            end do
+           end do
+          end do     ! End of 3D Fine Mesh Filling do-loops
+         end if      ! End 3D fine mesh option
+
+       If(n_3d_coarse .gt. 0) then     !  Fill the 3D coarse mesh bins
+        q1 = -0.5*binsize_3d_coarse
+        do i = 1,n_3d_coarse
+         q1 = q1 + binsize_3d_coarse
+         if(switch_3d.eq.1) b1=exp(-q1*q1*Rsidesq)
+         if(switch_3d.eq.2) b1=exp(-q1*q1*Rperpsq)
+
+          q2 = -0.5*binsize_3d_coarse
+          do j = 1,n_3d_coarse
+           q2 = q2 + binsize_3d_coarse
+           if(switch_3d.eq.1) b2=exp(-q2*q2*Routsq)
+           if(switch_3d.eq.2) b2=exp(-q2*q2*Rparallelsq)
+
+            q3 = -0.5*binsize_3d_coarse
+            do k = 1,n_3d_coarse
+             q3 = q3 + binsize_3d_coarse
+             if(switch_3d.eq.1) b3=exp(-q3*q3*Rlongsq)
+             if(switch_3d.eq.2) b3=exp(-q3*q3*R0sq)
+
+             b = b1*b2*b3
+             if(switch_3d.eq.1) q = sqrt(q1*q1+q2*q2+q3*q3)
+             if(switch_3d.eq.2) q = sqrt(q1*q1+q2*q2)
+
+             if(switch_type.eq.1 .or. switch_type.eq.3) then
+              c2mod_like_3d_coarse(i,j,k) = 1.0+fermi_bose_sign*(lambda
+     1                         *b*b + coherence_fac*b)
+              if(switch_coulomb.eq.0) then
+                coulomb_factor = 1.0
+              else if(switch_coulomb.gt.0) then
+                Call coulomb(switch_coulomb,q,1,massavg,Q0,
+     1                       coulomb_factor)
+              end if
+              c2mod_like_3d_coarse(i,j,k) =
+     1           coulomb_factor*c2mod_like_3d_coarse(i,j,k)
+             end if
+
+             if(switch_type.eq.2 .or. switch_type.eq.3) then
+              c2mod_unlike_3d_coarse(i,j,k) = 1.0 
+              if(switch_coulomb.eq.0) then
+                coulomb_factor = 1.0
+              else if(switch_coulomb.gt.0) then
+                Call coulomb(switch_coulomb,q,-1,massavg,Q0,
+     1                       coulomb_factor)
+              end if
+              c2mod_unlike_3d_coarse(i,j,k) =
+     1           coulomb_factor*c2mod_unlike_3d_coarse(i,j,k)
+             end if
+
+            end do
+           end do
+          end do     ! End of 3D Coarse Mesh Filling do-loops
+          c2mod_like_3d_coarse(1,1,1) = 0.0
+          c2mod_unlike_3d_coarse(1,1,1) = 0.0
+        end if       ! End of 3D Coarse Mesh Option
+
+      End If         ! End of 3D Option
+
+      Return
+      END
+
+C----------------------------------------------------------------------
+
+
+      subroutine coulomb(control,q,sign,mass,Q0,factor)
+      implicit none
+
+CCC   Compute Coulomb correction to the two-body correlation functions
+C     for like and unlike charges for particles of the same mass.
+C     Three methods are allowed:
+C
+C     If control = 1, Then use the gamow factor for point sources
+C     If control = 2, Then use the NA35 finite source size empirical
+C                     correction factor from eq.(5) in Z. Phys. C73,
+C                     443 (1997).
+C     If control = 3, Then use the Pratt finite source size, numerically
+C                     integrated Coulomb correction factor with inter-
+C                     polated tables.
+C
+C     Other parameters in the argument list are:
+C
+C        q     = 3-vector momentum difference for track pair, in GeV/c.
+C        sign  = algebraic sign of the charge product for the track pair.
+C        mass  = particle mass in GeV, it is assumed that both particles
+C                have the same mass, e.g. pi+ and pi-, but not K+ and pi-.
+C        Q0    = NA35 parameter in GeV/c if control = 2
+C              = Source radius in fm if control = 3
+C       factor = Multiplicative Coulomb correction result which is
+C                calculated here and returned to the calling program.
+C
+
+      Include 'common_coulomb.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 control, sign
+
+      real*4 pi,q,mass,Q0,factor,alpha,eta,eta2pi
+      real*4 gamow
+      parameter (pi = 3.141592654)
+      parameter (alpha = 0.00729735)
+
+CCC   Compute Gamow factor for control options 1 and 2:
+
+      if(control.eq.1 .or. control.eq.2) then
+         if(q .le. 0.001) then
+            if(sign .gt. 0) gamow = 0.0
+            if(sign .lt. 0) gamow = 86.0
+         else
+            eta = sign*mass*alpha/q
+            eta2pi = 2.0*pi*eta
+            gamow = eta2pi/(exp(eta2pi) - 1.0)
+         end if
+      end if
+
+CCC   Compute Coulomb Correction factor for options 1, 2 and 3:
+
+      if(control .eq. 1) then
+         factor = gamow
+      else if(control .eq. 2) then
+         factor = 1.0 + (gamow - 1.0)*exp(-q/Q0)
+      else if(control .eq. 3) then
+
+         if(q .le. q_coul(1)) then
+            if(sign .gt. 0) factor = c2_coul_like(1)
+            if(sign .lt. 0) factor = c2_coul_unlike(1)
+         else if(q .ge. q_coul(max_c2_coul - 1)) then
+            if(sign .gt. 0) factor = c2_coul_like(max_c2_coul - 1)
+            if(sign .lt. 0) factor = c2_coul_unlike(max_c2_coul - 1)
+         else
+            if(sign .gt. 0) then
+               Call LAGRNG(q,q_coul,factor,c2_coul_like,
+     1                     max_c2_coul,1,5,max_c2_coul,1)
+            else if(sign .lt. 0) then
+               Call LAGRNG(q,q_coul,factor,c2_coul_unlike,
+     1                     max_c2_coul,1,5,max_c2_coul,1)
+            end if
+         end if
+      end if  ! END Coulomb correction evaluation, control selection opt.
+
+      Return
+      END
+
+C---------------------------------------------------------------------
+
+
+      SUBROUTINE LAGRNG (X,ARG,Y,VAL,NDIM,NFS,NPTS,MAXARG,MAXFS)
+        IMPLICIT REAL*4(A-H,O-Z)
+C
+C     LAGRANGE INTERPOLATION,UNEQUALLY SPACED POINTS
+C     ROUTINE OBTAINED FROM R. LANDAU, UNIV. OF OREGON.
+C     ARG=VECTOR OF INDEPENDENT VARIABLE CONTAINING MAXARG VALUES.
+C     VAL=MATRIX OF FUNCTION VALUES CORRESPONDING TO ARG. (MAXFS
+C         FUNCTIONS AT MAXARG VALUES.)
+C     X  =VALUE OF INDEP. VARIABLE FOR WHICH INTERPOLATION IS DESIRED.
+C     Y  =VECTOR OF MAXFS FUNCTION VALUES RESULTING FROM SIMUL. INTERP.
+C     NDIM=NUMBER OF ARG VALUES TO BE USED. (NDIM.LE.MAXARG)
+C     NFS=NUMBER OF FUNCTIONS SIMUL. INTERP (NFS.LE.MAXFS)
+C     NPTS=NUMBER OF POINTS USED IN INTERPOLATION. (NPTS=2,3,4,5,6)
+C
+      DIMENSION ARG(MAXARG), VAL(MAXFS,MAXARG), Y(MAXFS)
+C
+C     -----FIND X0, THE CLOSEST POINT TO X.
+C
+      NI=1
+      NF=NDIM
+   10 IF ((X.LE.ARG(NI)).OR.(X.GE.ARG(NF))) GO TO 30
+      IF ((NF-NI+1).EQ.2) GO TO 70
+      NMID=(NF+NI)/2
+      IF (X.GT.ARG(NMID)) GO TO 20
+      NF=NMID
+      GO TO 10
+   20 NI=NMID
+      GO TO 10
+C
+C     ------ X IS ONE OF THE TABLULATED VALUES.
+C
+   30 IF (X.LE.ARG(NI)) GO TO 60
+      NN=NF
+   40 NUSED=0
+      DO 50 N=1,NFS
+   50 Y(N)=VAL(N,NN)
+      RETURN
+   60 NN=NI
+      GO TO 40
+C
+C     ------- 2 PTS LEFT, CHOOSE SMALLER ONE.
+C
+   70 N0=NI
+      NN=NPTS-2
+      GO TO (110,100,90,80), NN
+   80 CONTINUE
+      IF (((N0+3).GT.NDIM).OR.((N0-2).LT.1)) GO TO 90
+      NUSED=6
+      GO TO 130
+   90 CONTINUE
+      IF ((N0+2).GT.NDIM) GO TO 110
+      IF ((N0-2).LT.1) GO TO 100
+      NUSED=5
+      GO TO 130
+  100 CONTINUE
+      IF (((N0+2).GT.NDIM).OR.((N0-1).LT.1)) GO TO 110
+      NUSED=4
+      GO TO 130
+  110 IF ((N0+1).LT.NDIM) GO TO 120
+C
+C     ------N0=NDIM, SPECIAL CASE.
+C
+      NN=NDIM
+      GO TO 40
+  120 NUSED=3
+      IF ((N0-1).LT.1) NUSED=2
+  130 CONTINUE
+C
+C     ------AT LEAST 2 PTS LEFT.
+C
+      Y0=X-ARG(N0)
+      Y1=X-ARG(N0+1)
+      Y01=Y1-Y0
+      C0=Y1/Y01
+      C1=-Y0/Y01
+      IF (NUSED.EQ.2) GO TO 140
+C
+C     ------AT LEAST 3 PTS.
+C
+      YM1=X-ARG(N0-1)
+      Y0M1=YM1-Y0
+      YM11=Y1-YM1
+      CM1=-Y0*Y1/Y0M1/YM11
+      C0=C0*YM1/Y0M1
+      C1=-C1*YM1/YM11
+      IF (NUSED.EQ.3) GO TO 160
+C
+C     ------AT LEAST 4 PTS
+C
+      Y2=X-ARG(N0+2)
+      YM12=Y2-YM1
+      Y02=Y2-Y0
+      Y12=Y2-Y1
+      CM1=CM1*Y2/YM12
+      C0=C0*Y2/Y02
+      C1=C1*Y2/Y12
+      C2=-YM1*Y0*Y1/YM12/Y02/Y12
+      IF (NUSED.EQ.4) GO TO 180
+C
+C     ------AT LEAST 5 PTS.
+C
+      YM2=X-ARG(N0-2)
+      YM2M1=YM1-YM2
+      YM20=Y0-YM2
+      YM21=Y1-YM2
+      YM22=Y2-YM2
+      CM2=YM1*Y0*Y1*Y2/YM2M1/YM20/YM21/YM22
+      CM1=-CM1*YM2/YM2M1
+      C0=-C0*YM2/YM20
+      C1=-C1*YM2/YM21
+      C2=-C2*YM2/YM22
+      IF (NUSED.EQ.5) GO TO 200
+C
+C     ------AT LEAST 6 PTS.
+C
+      Y3=X-ARG(N0+3)
+      YM23=Y3-YM2
+      YM13=Y3-YM1
+      Y03=Y3-Y0
+      Y13=Y3-Y1
+      Y23=Y3-Y2
+      CM2=CM2*Y3/YM23
+      CM1=CM1*Y3/YM13
+      C0=C0*Y3/Y03
+      C1=C1*Y3/Y13
+      C2=C2*Y3/Y23
+      C3=YM2*YM1*Y0*Y1*Y2/YM23/YM13/Y03/Y13/Y23
+      GO TO 220
+  140 CONTINUE
+      DO 150 N=1,NFS
+  150 Y(N)=C0*VAL(N,N0)+C1*VAL(N,N0+1)
+      GO TO 240
+  160 CONTINUE
+      DO 170 N=1,NFS
+  170 Y(N)=CM1*VAL(N,N0-1)+C0*VAL(N,N0)+C1*VAL(N,N0+1)
+      GO TO 240
+  180 CONTINUE
+      DO 190 N=1,NFS
+  190 Y(N)=CM1*VAL(N,N0-1)+C0*VAL(N,N0)+C1*VAL(N,N0+1)+C2*VAL(N,N0+2)
+      GO TO 240
+  200 CONTINUE
+      DO 210 N=1,NFS
+  210 Y(N)=CM2*VAL(N,N0-2)+CM1*VAL(N,N0-1)+C0*VAL(N,N0)+C1*VAL(N,N0+1)+C
+     12*VAL(N,N0+2)
+      GO TO 240
+  220 CONTINUE
+      DO 230 N=1,NFS
+  230 Y(N)=CM2*VAL(N,N0-2)+CM1*VAL(N,N0-1)+C0*VAL(N,N0)+C1*VAL(N,N0+1)+C
+     12*VAL(N,N0+2)+C3*VAL(N,N0+3)
+  240 RETURN
+C
+      END
+
+C-------------------------------------------------------------------
+
+
+      subroutine Hbtp_kin(px,py,pz,E,pt,phi,eta,mass,control)
+      implicit none
+
+CCC   Four-momentum kinematics conversion:
+C
+C        If control = 1, use input {px,py,pz,mass} to calculate
+C                        {E,pt,phi,eta}
+C        If control = 2, use input {pt,phi,eta,mass} to calculate
+C                        {px,py,pz,E}
+C
+C        Units:  Momentum are in GeV/c
+C                Energy and mass are in GeV
+C                Angles are in degrees
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 control
+
+      real*4 px,py,pz,E,pt,phi,eta,mass
+      real*4 theta,pi,rad,pcut
+      parameter (pi = 3.141592654)
+      parameter (pcut = 0.000001)
+
+      rad = 180.0/pi
+
+      If(control .eq. 1) Then   !   Use {px,py,pz,mass} --> {E,pt,phi,eta}
+         pt = sqrt(px*px + py*py)
+         E  = sqrt(pt*pt + pz*pz + mass*mass)
+
+CCC   Compute azimuthal angle phi; treat pt = 0.0 and py = 0.0 cases
+CCC   separate.
+
+         if(pt .le. pcut) then
+            phi = 0.0
+         else if(pt.gt.pcut.and.abs(py).le.pcut.and.px.lt.0.0) then
+            phi = pi
+         else
+            phi = atan2(py,px)
+         end if
+         if(phi .lt. 0.0) phi = phi + 2.0*pi
+         phi = phi*rad
+
+CCC   Compute pseudorapidity:
+
+         if(pt.le.pcut .and. abs(pz).le.pcut) then
+            eta = 0.0
+         else if(pt.le.pcut .and. abs(pz).gt.pcut) then
+            eta = 0.5*log((E+pz)/(E-pz))   !  Use beam rapidity
+         else
+            theta = atan2(pt,pz)
+            eta   = -log(tan(theta/2.0))
+         end if
+
+      Else If(control .eq. 2) Then  ! Use {pt,phi,eta,mass} --> {E,px,py,pz}
+
+         px = pt*cos(phi/rad)
+         py = pt*sin(phi/rad)
+         if(abs(eta) .le. pcut) then
+            pz = 0.0
+         else
+            theta = 2.0*atan(exp(-eta))
+            pz = pt/tan(theta)
+         end if
+
+         E = sqrt(pt*pt + pz*pz + mass*mass)
+
+      End If   !  End control options
+
+      Return
+      END
+
+C----------------------------------------------------------------------
+
+
+      subroutine qdiff(px1,py1,pz1,E1,px2,py2,pz2,E2,qinvar2,qtotal2,
+     1           qvector2,qside2,qout2,qlong2,qperp2,qtime2)
+      implicit none
+
+CCC   This subroutine computes the various relative momenta for given
+CCC   input 4-momentum for particles 1 and 2.  The subr: returns the
+CCC   square of the momentum. All energy and momenta are in GeV.
+C
+C     Input 4-momentum for particle 1: {px1,py1,pz1,E1}
+C     Input 4-momentum for particle 2: {px2,py2,pz2,E2}
+C
+CCC   Computed Momentum Differences are the following:
+C
+C        qinvar2   = Q-invariant**2
+C        qtotal2   = Q-Total**2      (space**2 + time**2)
+C        qvector2  = 3-momentum vector difference squared
+C        qside2    = q-side**2 of Bertsch-Pratt 3D source models
+C        qout2     = q-out**2  of Bertsch-Pratt 3D source models
+C        qlong2    = q-long**2 of Bertsch-Pratt 3D source models
+C        qperp2    = q-perpendicular**2 of YKP 3D source models
+C        qparallel2= q-parallel**2 of YKP 3D source models
+C                  = qlong2 (not assigned a separate variable name)
+C        qtime2    = q-time-like**2 of YKP 3D source models
+    
+CCC   Local Variable Type Declarations:
+
+      real*4 px1,py1,pz1,E1,px2,py2,pz2,E2
+      real*4 qinvar2,qtotal2,qvector2
+      real*4 qside2,qout2,qlong2
+      real*4 qperp2,qtime2
+      real*4 px12sq,py12sq,pz12sq,E12sq
+
+      px12sq = (px1 - px2)**2
+      py12sq = (py1 - py2)**2
+      pz12sq = (pz1 - pz2)**2
+      E12sq  = (E1  -  E2)**2
+        
+      qvector2   = px12sq + py12sq + pz12sq
+      qinvar2    = qvector2 - E12sq
+      qtotal2    = qvector2 + E12sq
+
+      qlong2     = pz12sq
+      qout2      = (px1*px1 - px2*px2 + py1*py1 - py2*py2)
+      qout2      = qout2*qout2/((px1+px2)**2 + (py1+py2)**2)
+      qperp2     = px12sq + py12sq
+      qside2     = qperp2 - qout2
+      qtime2     = E12sq
+      if (qside2 .lt. 0) then
+C        write(*,*) 'qside2 is less then 0', qside2
+C      write(*,*) ' qperp2, qout2', qperp2, qout2
+C      write(*,*) ' px1,py1,pz1,E1 ',px1,py1,pz1,E1
+C      write(*,*) ' px2,py2,pz2,E2 ',px2,py2,pz2,E2
+       qside2 = 0.0
+      end if
+      Return
+      END
+
+C----------------------------------------------------------------------- 
+
+
+      subroutine mean_rms(a,ndim,npts,mean,rms)
+      implicit none
+
+CCC   Calculate the mean and standard deviation (rms) for input
+C     distribution a() for npts number of values.
+C     ndim = dimension of array a() in calling program.
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 ndim, npts, i
+      real*4 a(ndim), mean, rms, sum_mean, sum_rms
+
+      if(npts .le. 0) then
+         mean = 0.0
+         rms  = 0.0
+         return
+      else if(npts .eq. 1) then
+         mean = a(1)
+         rms  = 0.0
+         return
+      else
+         sum_mean = 0.0
+         sum_rms  = 0.0
+         do i = 1,npts
+         sum_mean = sum_mean + a(i)
+         end do
+         mean = sum_mean/float(npts)
+
+         do i = 1,npts
+         sum_rms  = sum_rms + (a(i) - mean)**2
+         end do
+         rms = sqrt((sum_rms)/float(npts - 1))
+         return
+      end if
+
+      END
+
+C-----------------------------------------------------------------------
+
+
+      subroutine tindex(mode,track_id)
+      implicit none
+
+CCC   This subroutine locates tracks in {px,py,pz} sectors
+C     and sets the sector index numbers
+C     in track table 'trk' and/or 'trk2', depending on the value of 'mode'.
+C     If a track's momentum is out of the sector ranges, then the track
+C     will be assigned to, and counted in the nearest sector cell on the
+C     edge or corner.
+C
+C     If mode = 1, apply to tracks in table 'trk'
+C     If mode = 2, apply to tracks in table 'trk2'
+C
+C     If track_id = 0, then do this for all tracks
+C     If track_id = i (where i.gt.0) then do this for track row i only
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,track_id,mode
+
+C-----------------------
+      If(mode.eq.1) Then
+C-----------------------
+
+       If(track_id .eq. 0) Then
+         do i = 1,n_part_tot_trk
+         trk_px_sec(i) = int(((trk_px(i) - px_min)/delpx)+1.00001)
+            if(trk_px_sec(i) .lt.1) trk_px_sec(i) = 1
+            if(trk_px_sec(i) .gt. n_px_bins) trk_px_sec(i) = n_px_bins
+         trk_py_sec(i) = int(((trk_py(i) - py_min)/delpy)+1.00001)
+            if(trk_py_sec(i) .lt.1) trk_py_sec(i) = 1
+            if(trk_py_sec(i) .gt. n_py_bins) trk_py_sec(i) = n_py_bins
+         trk_pz_sec(i) = int(((trk_pz(i) - pz_min)/delpz)+1.00001)
+            if(trk_pz_sec(i) .lt.1) trk_pz_sec(i) = 1
+            if(trk_pz_sec(i) .gt. n_pz_bins) trk_pz_sec(i) = n_pz_bins
+         trk_sector(i) = trk_px_sec(i) + (trk_py_sec(i) - 1)*
+     1      n_px_bins + (trk_pz_sec(i) - 1)*n_px_bins*n_py_bins
+         end do
+
+       Else If(track_id .gt. 0) Then
+         i = track_id
+         trk_px_sec(i) = int(((trk_px(i) - px_min)/delpx)+1.00001)
+            if(trk_px_sec(i) .lt.1) trk_px_sec(i) = 1
+            if(trk_px_sec(i) .gt. n_px_bins) trk_px_sec(i) = n_px_bins
+         trk_py_sec(i) = int(((trk_py(i) - py_min)/delpy)+1.00001)
+            if(trk_py_sec(i) .lt.1) trk_py_sec(i) = 1
+            if(trk_py_sec(i) .gt. n_py_bins) trk_py_sec(i) = n_py_bins
+         trk_pz_sec(i) = int(((trk_pz(i) - pz_min)/delpz)+1.00001)
+            if(trk_pz_sec(i) .lt.1) trk_pz_sec(i) = 1
+            if(trk_pz_sec(i) .gt. n_pz_bins) trk_pz_sec(i) = n_pz_bins
+         trk_sector(i) = trk_px_sec(i) + (trk_py_sec(i) - 1)*
+     1      n_px_bins + (trk_pz_sec(i) - 1)*n_px_bins*n_py_bins
+       End If
+
+C-----------------------------
+      Else If (mode.eq.2) Then
+C-----------------------------
+
+       If(track_id .eq. 0) Then
+         do i = 1,n_part_tot_trk2
+         trk2_px_sec(i) = int(((trk2_px(i) - px_min)/delpx)+1.00001)
+            if(trk2_px_sec(i) .lt.1) trk2_px_sec(i) = 1
+            if(trk2_px_sec(i) .gt. n_px_bins) trk2_px_sec(i) = n_px_bins
+         trk2_py_sec(i) = int(((trk2_py(i) - py_min)/delpy)+1.00001)
+            if(trk2_py_sec(i) .lt.1) trk2_py_sec(i) = 1
+            if(trk2_py_sec(i) .gt. n_py_bins) trk2_py_sec(i) = n_py_bins
+         trk2_pz_sec(i) = int(((trk2_pz(i) - pz_min)/delpz)+1.00001)
+            if(trk2_pz_sec(i) .lt.1) trk2_pz_sec(i) = 1
+            if(trk2_pz_sec(i) .gt. n_pz_bins) trk2_pz_sec(i) = n_pz_bins
+         trk2_sector(i) = trk2_px_sec(i) + (trk2_py_sec(i) - 1)*
+     1      n_px_bins + (trk2_pz_sec(i) - 1)*n_px_bins*n_py_bins
+         end do
+
+       Else If(track_id .gt. 0) Then
+         i = track_id
+         trk2_px_sec(i) = int(((trk2_px(i) - px_min)/delpx)+1.00001)
+            if(trk2_px_sec(i) .lt.1) trk2_px_sec(i) = 1
+            if(trk2_px_sec(i) .gt. n_px_bins) trk2_px_sec(i) = n_px_bins
+         trk2_py_sec(i) = int(((trk2_py(i) - py_min)/delpy)+1.00001)
+            if(trk2_py_sec(i) .lt.1) trk2_py_sec(i) = 1
+            if(trk2_py_sec(i) .gt. n_py_bins) trk2_py_sec(i) = n_py_bins
+         trk2_pz_sec(i) = int(((trk2_pz(i) - pz_min)/delpz)+1.00001)
+            if(trk2_pz_sec(i) .lt.1) trk2_pz_sec(i) = 1
+            if(trk2_pz_sec(i) .gt. n_pz_bins) trk2_pz_sec(i) = n_pz_bins
+         trk2_sector(i) = trk2_px_sec(i) + (trk2_py_sec(i) - 1)*
+     1      n_px_bins + (trk2_pz_sec(i) - 1)*n_px_bins*n_py_bins
+       End If
+
+C------------
+      End If
+C------------
+
+      Return
+      END
+
+C------------------------------------------------------------------------
+
+
+      subroutine stm_build(mode,track_index,old_sector)
+      implicit none
+
+CCC   This subroutine fills or updates the track-sector information
+C     table sec_trk_map or, for the reference calculations, it fills
+C     sec_trk_map2.  These track-sector tables contain the information
+C     about the track occupancy, status, etc. for all of the {px,py,pz}
+C     sectors.
+C
+C     For Mode = 1:
+C
+C        If track_index = 0, then fill information for all tracks in 'trk',
+C                            into table 'stm'
+C        If track_index = i (where i.gt.0) then fill only the track-sector
+C                           information for track i in 'trk', into table 'stm'
+C                           Also for this case, if old_sector .ne. 0, then
+C                           remove the track # and ID information for this
+C                           old sector # from table stm
+C
+C     For Mode = 2: Fill information for all tracks in 'trk2' into table 'stm2'
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,j,mode,track_index,old_sector,row
+      integer*4 temp(max_trk_sec)
+
+C------------------------
+      IF (mode.eq.1) Then
+C------------------------
+
+       If (track_index .eq. 0) Then
+         do i = 1,sec_maxlen
+            stm_sec_id(i) = 0
+            stm_n_trk_sec(i) = 0
+            do j = 1,max_trk_sec
+               stm_track_id(j,i) = 0
+            end do
+            stm_flag(i) = 0
+         end do
+         do i = 1,n_sectors
+         stm_sec_id(i) = i
+         end do
+         do i = 1,n_part_tot_trk
+         if(trk_flag(i) .eq. 0) then
+         row = trk_sector(i)
+         stm_n_trk_sec(row) = stm_n_trk_sec(row) + 1
+         if(stm_n_trk_sec(row) .le. max_trk_sec) then
+            stm_track_id(stm_n_trk_sec(row),row) = trk_id(i)
+            stm_flag(row) = 0
+            trk_flag(i)   = 0
+         else
+            stm_n_trk_sec(row) = stm_n_trk_sec(row) - 1
+            stm_flag(row) = 1
+            trk_flag(i)   = 1
+            trk_sector(i) = 0
+         end if
+         end if
+         end do
+
+       Else If (track_index .gt. 0) Then
+
+         if(old_sector .ne. 0) then
+CCC   Remove track from old sector:
+            j = 0
+            do i = 1,stm_n_trk_sec(old_sector)
+               if(stm_track_id(i,old_sector) .ne. track_index) then
+                  j = j + 1
+                  temp(j) = stm_track_id(i,old_sector)
+               end if
+            end do
+            stm_n_trk_sec(old_sector) = j
+            do i = 1,max_trk_sec
+               stm_track_id(i,old_sector) = 0
+            end do
+            do i = 1,stm_n_trk_sec(old_sector)
+               stm_track_id(i,old_sector) = temp(i)
+            end do
+         end if
+CCC   Update with new sector location of track:
+         i = track_index
+         if(trk_flag(i) .eq. 0) then
+         row = trk_sector(i)
+         stm_n_trk_sec(row) = stm_n_trk_sec(row) + 1
+         if(stm_n_trk_sec(row) .le. max_trk_sec) then
+            stm_track_id(stm_n_trk_sec(row),row) = trk_id(i)
+            stm_flag(row) = 0
+            trk_flag(i)   = 0
+         else
+            stm_n_trk_sec(row) = stm_n_trk_sec(row) - 1
+            stm_flag(row) = 1
+            trk_flag(i)   = 1
+            trk_sector(i) = 0
+         end if
+         end if
+       End If
+
+C-----------------------------
+      Else If (mode.eq.2) Then
+C-----------------------------
+
+       If (track_index .eq. 0) Then
+         do i = 1,sec_maxlen2
+            stm2_sec_id(i) = 0
+            stm2_n_trk_sec(i) = 0
+            do j = 1,max_trk_sec2
+               stm2_track_id(j,i) = 0
+            end do
+            stm2_flag(i) = 0
+         end do
+         do i = 1,n_sectors
+         stm2_sec_id(i) = i
+         end do
+         do i = 1,n_part_tot_trk2
+         if(trk2_flag(i) .eq. 0) then
+         row = trk2_sector(i)
+         stm2_n_trk_sec(row) = stm2_n_trk_sec(row) + 1
+         if(stm2_n_trk_sec(row) .le. max_trk_sec2) then
+            stm2_track_id(stm2_n_trk_sec(row),row) = trk2_id(i)
+            stm2_flag(row) = 0
+            trk2_flag(i)   = 0
+         else
+            stm2_n_trk_sec(row) = stm2_n_trk_sec(row) - 1
+            stm2_flag(row) = 1
+            trk2_flag(i)   = 1
+            trk2_sector(i) = 0
+         end if
+         end if
+         end do
+       end if
+
+C------------
+      End If   !  End mode = 1,2 selection options
+C------------
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+
+      subroutine sec_index(index,nbins,index_min,index_max)
+      implicit none
+
+CCC   Calculate track-sector neighboring bins and min->max range:
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 index,nbins,index_min,index_max
+
+      index_min = index - 1
+      if(index_min .lt. 1) index_min = 1
+      index_max = index + 1
+      if(index_max .gt. nbins) index_max = nbins
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+
+      subroutine dist_range(mode,ntracks_out,ntracks_flagged)
+      implicit none
+
+CCC   Determine if tracks are out of acceptance range in pt, phi and eta,
+C     and, if so, then set the 'out_flag' variable in the track table 'trk'
+
+CCC   For Mode = 1, use track table 'trk'
+CCC   For Mode = 2, use track table 'trk2'
+
+CCC   Count the number of flagged tracks, i.e. trk(i).flag = 1, and "out
+C     of acceptance range" tracks, i.e. trk(i).out_flag = 1, for both
+C     particle ID types.  Determine the number of tracks to use in the
+C     correlation fit for each particle ID type.
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,mode,ntracks_out,ntracks_flagged
+
+C------------------------
+      If (mode.eq.1) Then
+C------------------------
+
+      do i = 1,trk_maxlen
+      trk_out_flag(i) = 0
+      end do
+
+      ntracks_flagged = 0
+
+      do i = 1,n_part_tot_trk
+      if(trk_flag(i) .eq. 0) then
+      if(trk_pt(i) .lt. pt_min .or. trk_pt(i) .gt. pt_max)
+     1   trk_out_flag(i)=1
+      if(trk_phi(i).lt.phi_min .or. trk_phi(i).gt.phi_max)
+     1   trk_out_flag(i)=1
+      if(trk_eta(i).lt.eta_min .or. trk_eta(i).gt.eta_max)
+     1   trk_out_flag(i)=1
+      else if(trk_flag(i) .eq. 1) then
+      ntracks_flagged = ntracks_flagged + 1
+      end if
+      end do
+
+      ntracks_out = 0
+      do i = 1,n_part_tot_trk
+      if(trk_out_flag(i) .eq. 1) ntracks_out = ntracks_out + 1
+      end do
+
+      n_part_used_1_trk = 0
+      n_part_used_2_trk = 0
+      do i = 1,n_part_tot_trk
+         if(trk_flag(i) .eq. 0) then
+            if(trk_ge_pid(i) .eq. pid(1)) then
+               n_part_used_1_trk = n_part_used_1_trk + 1
+            else if(trk_ge_pid(i) .eq. pid(2)) then
+               n_part_used_2_trk = n_part_used_2_trk + 1
+            end if
+         end if
+      end do 
+
+C-----------------------------
+      Else If (mode.eq.2) Then
+C-----------------------------
+
+      do i = 1,trk2_maxlen
+      trk2_out_flag(i) = 0
+      end do
+
+      ntracks_flagged = 0
+
+      do i = 1,n_part_tot_trk2
+      if(trk2_flag(i) .eq. 0) then
+      if(trk2_pt(i) .lt. pt_min .or. trk2_pt(i) .gt. pt_max)
+     1   trk2_out_flag(i)=1
+      if(trk2_phi(i).lt.phi_min .or. trk2_phi(i).gt.phi_max)
+     1   trk2_out_flag(i)=1
+      if(trk2_eta(i).lt.eta_min .or. trk2_eta(i).gt.eta_max)
+     1   trk2_out_flag(i)=1
+      else if(trk2_flag(i) .eq. 1) then
+      ntracks_flagged = ntracks_flagged + 1
+      end if
+      end do
+
+      ntracks_out = 0
+      do i = 1,n_part_tot_trk2
+      if(trk2_out_flag(i) .eq. 1) ntracks_out = ntracks_out + 1
+      end do
+
+      n_part_used_1_trk2 = 0
+      n_part_used_2_trk2 = 0
+      do i = 1,n_part_tot_trk2
+         if(trk2_flag(i) .eq. 0) then
+            if(trk2_ge_pid(i) .eq. pid(1)) then
+               n_part_used_1_trk2 = n_part_used_1_trk2 + 1
+            else if(trk2_ge_pid(i) .eq. pid(2)) then
+               n_part_used_2_trk2 = n_part_used_2_trk2 + 1
+            end if
+         end if
+      end do 
+
+C------------
+      End If  !  End mode = 1,2 selection option
+C------------
+
+      Return
+      END
+
+C--------------------------------------------------------------------
+
+
+      subroutine histog1(mode,itrack,pid_index,pidnum,pt_save,
+     1                   phi_save,eta_save)
+      implicit none
+
+CCC   This subroutine computes and/or updates the one-body histograms
+C     according to the selected 'mode' and for the requested particle
+C     ID type.
+
+C     Note:  If the track momentum is out-of-range in {pt,phi,eta},
+C            then it is ignored.  The {pt,phi,eta} dependences for 
+C            the 1-dimensional histogramming are treated independently.
+C            It is therefore possible for the sum of the number of
+C            particles in the pt, phi and eta one-body, 1D histograms
+C            to be unequal.
+
+CCC   Mode = 1,  Fill the one-body histograms (hist1*) for selected
+C                particle ID type, for the initial input distribution,
+C                using the momenta in 'trk'
+C
+C     Mode = 2,  Remove particle 'itrack' from temporary one-body hist-
+C                ogram (htmp1*) for selected particle ID type, using
+C                momentum values given by pt_save, phi_save, eta_save.
+C
+C     Mode = 3,  Add particle 'itrack' to the temporary one-body hist-
+C                ogram (htmp1*) for selected particle ID type, using
+C                momentum values in track table 'trk'. 
+C
+C     Mode = 4,  Fill the one-body histograms (hist1*) for selected
+C                particle ID type, for the initial input distribution,
+C                using the momenta in 'trk2'
+C
+C     itrack =   track index # for the removed or added track for mode =
+C                2 or 3, respectively.
+C
+C     pid_index = 1 or 2 for the first or second particle ID type, and
+C                 for filling/update either hist1*1 or hist1*2, and
+C                 similarly for htmp1*1 or htmp1*2
+C
+C     pidnum    =   Geant particle ID # for the track(s) to be filled or
+C                updated.
+C
+C     pt_save  = Removed track's pt value.
+C
+C     phi_save = Removed track's phi value.
+C
+C     eta_save = Removed track's eta value.
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 mode,itrack,i,pid_index,pidnum,index
+      integer*4 trk_counter,trk2_counter
+
+      real*4    pt_save,phi_save,eta_save
+      real*4    delpt,delphi,deleta
+
+C-------------------------
+      If (mode.eq.1) Then
+C-------------------------
+
+CCC   Fill one-body histograms for requested particle ID from table 'trk'
+CCC   Initialize necessary arrays to zero:
+
+         if(pid_index .eq. 1) then
+            do i = 1,max_h_1d
+               hist1_pt_1(i)  = 0
+               hist1_phi_1(i) = 0
+               hist1_eta_1(i) = 0
+            end do
+         else if(pid_index .eq. 2) then
+            do i = 1,max_h_1d
+               hist1_pt_2(i)  = 0
+               hist1_phi_2(i) = 0
+               hist1_eta_2(i) = 0
+            end do
+         end if
+
+         trk_counter = 0
+
+         do i = 1,n_part_tot_trk
+            if(trk_ge_pid(i).eq.pidnum .and. trk_flag(i).eq.0) then
+               trk_counter = trk_counter + 1
+               delpt  = trk_pt(i)   - pt_min
+               delphi = trk_phi(i)  - phi_min
+               deleta = trk_eta(i)  - eta_min
+
+               index = int((delpt/pt_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) hist1_pt_1(index) =
+     1                               hist1_pt_1(index) + 1
+                  if(pid_index.eq.2) hist1_pt_2(index) =
+     1                               hist1_pt_2(index) + 1
+               end if
+
+               index = int((delphi/phi_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) hist1_phi_1(index) =
+     1                               hist1_phi_1(index) + 1
+                  if(pid_index.eq.2) hist1_phi_2(index) =
+     1                               hist1_phi_2(index) + 1
+               end if
+
+               index = int((deleta/eta_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) hist1_eta_1(index) =
+     1                               hist1_eta_1(index) + 1
+                  if(pid_index.eq.2) hist1_eta_2(index) =
+     1                               hist1_eta_2(index) + 1
+               end if
+
+            end if
+         end do
+
+         if(pid_index .eq. 1) n_part_used_1_trk = trk_counter
+         if(pid_index .eq. 2) n_part_used_2_trk = trk_counter
+
+C--------------------------------
+      Else If (mode .eq. 2) Then
+C--------------------------------
+
+CCC   Remove track # 'itrack' from fitting histograms in htmp1*,
+CCC   use pt_save, phi_save, eta_save for the old momentum values
+CCC   in order to determine which bins to decrement.
+
+         if(trk_ge_pid(itrack).eq.pidnum.and.trk_flag(itrack).eq.0)then
+               delpt  = pt_save  - pt_min
+               delphi = phi_save - phi_min
+               deleta = eta_save - eta_min
+
+               index = int((delpt/pt_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) htmp1_pt_1(index) =
+     1                               htmp1_pt_1(index) - 1
+                  if(pid_index.eq.2) htmp1_pt_2(index) =
+     1                               htmp1_pt_2(index) - 1
+               end if
+
+               index = int((delphi/phi_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) htmp1_phi_1(index) =
+     1                               htmp1_phi_1(index) - 1
+                  if(pid_index.eq.2) htmp1_phi_2(index) =
+     1                               htmp1_phi_2(index) - 1
+               end if
+
+               index = int((deleta/eta_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) htmp1_eta_1(index) =
+     1                               htmp1_eta_1(index) - 1
+                  if(pid_index.eq.2) htmp1_eta_2(index) =
+     1                               htmp1_eta_2(index) - 1
+               end if
+
+         end if
+
+C--------------------------------
+      Else If (mode .eq. 3) Then
+C--------------------------------
+
+CCC   Add track # 'itrack' to fitting histograms in htmp1*,
+CCC   use pt, phi and eta values in track table 'trk(itrack)'
+CCC   for the new/added track position.
+
+         if(trk_ge_pid(itrack).eq.pidnum.and.trk_flag(itrack).eq.0)then
+               delpt  = trk_pt(itrack)  - pt_min
+               delphi = trk_phi(itrack) - phi_min
+               deleta = trk_eta(itrack) - eta_min
+
+               index = int((delpt/pt_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) htmp1_pt_1(index) =
+     1                               htmp1_pt_1(index) + 1
+                  if(pid_index.eq.2) htmp1_pt_2(index) =
+     1                               htmp1_pt_2(index) + 1
+               end if
+
+               index = int((delphi/phi_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) htmp1_phi_1(index) =
+     1                               htmp1_phi_1(index) + 1
+                  if(pid_index.eq.2) htmp1_phi_2(index) =
+     1                               htmp1_phi_2(index) + 1
+               end if
+
+               index = int((deleta/eta_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) htmp1_eta_1(index) =
+     1                               htmp1_eta_1(index) + 1
+                  if(pid_index.eq.2) htmp1_eta_2(index) =
+     1                               htmp1_eta_2(index) + 1
+               end if
+
+         end if
+
+C------------------------------
+      Else If (mode.eq.4) Then
+C------------------------------
+
+CCC   Fill one-body histograms for requested particle ID from table 'trk2'
+CCC   Initialize necessary arrays to zero:
+
+         if(pid_index .eq. 1) then
+            do i = 1,max_h_1d
+               hist1_pt_1(i)  = 0
+               hist1_phi_1(i) = 0
+               hist1_eta_1(i) = 0
+            end do
+         else if(pid_index .eq. 2) then
+            do i = 1,max_h_1d
+               hist1_pt_2(i)  = 0
+               hist1_phi_2(i) = 0
+               hist1_eta_2(i) = 0
+            end do
+         end if
+
+         trk2_counter = 0
+
+         do i = 1,n_part_tot_trk2
+            if(trk2_ge_pid(i).eq.pidnum .and. trk2_flag(i).eq.0) then
+               trk2_counter = trk2_counter + 1
+               delpt  = trk2_pt(i)   - pt_min
+               delphi = trk2_phi(i)  - phi_min
+               deleta = trk2_eta(i)  - eta_min
+
+               index = int((delpt/pt_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) hist1_pt_1(index) =
+     1                               hist1_pt_1(index) + 1
+                  if(pid_index.eq.2) hist1_pt_2(index) =
+     1                               hist1_pt_2(index) + 1
+               end if
+
+               index = int((delphi/phi_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) hist1_phi_1(index) =
+     1                               hist1_phi_1(index) + 1
+                  if(pid_index.eq.2) hist1_phi_2(index) =
+     1                               hist1_phi_2(index) + 1
+               end if
+
+               index = int((deleta/eta_bin_size) + 0.99999)
+               if(index.ge.1 .and. index.le.max_h_1d) then
+                  if(pid_index.eq.1) hist1_eta_1(index) =
+     1                               hist1_eta_1(index) + 1
+                  if(pid_index.eq.2) hist1_eta_2(index) =
+     1                               hist1_eta_2(index) + 1
+               end if
+
+            end if
+         end do
+
+         if(pid_index .eq. 1) n_part_used_1_trk2 = trk2_counter
+         if(pid_index .eq. 2) n_part_used_2_trk2 = trk2_counter
+
+C------------
+      End If   !   End Mode = 1,2,3,4 Selection Options
+C------------
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+      subroutine histog2(mode,itrack,px_sec_save,py_sec_save,
+     1           pz_sec_save,px_save,py_save,pz_save,E_save)
+      implicit none
+
+CCC   This subroutine computes and/or updates the two-body histograms
+C     according to the selected 'mode' and for the necessary particle
+C     ID type(s).
+
+C     Mode = 1,  Fill the two-body histograms (hist*) for all particles
+C                in table 'trk' for like and unlike pairs, for 1D and/or
+C                3D fine and 3D coarse mesh bins.
+C
+C     Mode = 2,  Remove all old track pairs for 'itrack' particle from 
+C                all htmp* histograms, for particles in table 'trk', for
+C                like and unlike pairs, for 1D and/or 3D fine and 3D coarse
+C                mesh bins; using the saved momentum and track values.
+C
+C     Mode = 3,  Add all new track pairs for 'itrack' particle to
+C                all htmp* histograms, for particles in table 'trk', for
+C                like and unlike pairs, for 1D and/or 3D fine and 3D coarse
+C                mesh bins; using the values in table 'trk(itrack).*'
+C
+C     Mode = 4,  Fill and accumulate reference histograms (href*) for all
+C                particle pairs from tables 'trk' and 'trk2', for like and
+C                unlike pairs, for 1D and/or 3D fine and 3D coarse
+C                mesh bins.
+C
+C     itrack =   single track index in table 'trk' for pairs to be removed
+C                (mode = 2) or added (mode = 3).
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 mode,itrack,i,j,k,jx,jy,jz
+      integer*4 jsec,trkj_sector,imin,imax,njtrks
+      integer*4 index1,index2,index3
+      integer*4 findex1,findex2,findex3
+      integer*4 ipxmin,ipymin,ipzmin
+      integer*4 ipxmax,ipymax,ipzmax
+      integer*4 trki_pid,trkj_pid
+      integer*4 px_sec_save,py_sec_save,pz_sec_save
+
+      real*4    qinvar2,qtotal2,qvector2
+      real*4    qside2, qout2,  qlong2
+      real*4    qperp2, qtime2
+      real*4    qdiff1, qdiff2, qdiff3
+      real*4    px_save,py_save,pz_save,E_save
+
+      If (mode .eq. 1) Then     ! Full hist* filling; initialize arrays to zero.
+
+        do i = 1,max_h_1d
+          hist_like_1d(i)   = 0
+          hist_unlike_1d(i) = 0
+        end do
+
+        do i = 1,max_h_3d
+        do j = 1,max_h_3d
+        do k = 1,max_h_3d
+          hist_like_3d_fine(i,j,k)     = 0
+          hist_unlike_3d_fine(i,j,k)   = 0
+          hist_like_3d_coarse(i,j,k)   = 0
+          hist_unlike_3d_coarse(i,j,k) = 0
+        end do
+        end do
+        end do
+
+      End If
+
+CCC   Select # of particles to loop over for each 'mode':
+
+      If (mode .eq. 1) Then
+         imin = 2
+         imax = n_part_tot_trk
+      Else If (mode .eq. 2 .or. mode .eq. 3) Then
+         imin = itrack
+         imax = itrack
+      Else If (mode .eq. 4) Then
+         imin = 1
+         imax = n_part_tot_trk
+      End If
+
+C------------------------------------------------------
+CCC   Begin Primary Loop over particles in Table 'trk':
+C------------------------------------------------------
+
+      do i = imin,imax
+      if(trk_flag(i) .eq. 0) then
+        trki_pid = trk_ge_pid(i)
+        if(mode.eq.2) then
+          Call sec_index(px_sec_save,n_px_bins,ipxmin,ipxmax)
+          Call sec_index(py_sec_save,n_py_bins,ipymin,ipymax)
+          Call sec_index(pz_sec_save,n_pz_bins,ipzmin,ipzmax)
+        else
+          Call sec_index(trk_px_sec(i),n_px_bins,ipxmin,ipxmax)
+          Call sec_index(trk_py_sec(i),n_py_bins,ipymin,ipymax)
+          Call sec_index(trk_pz_sec(i),n_pz_bins,ipzmin,ipzmax)
+        end if
+
+CCC   Begin Loop over neighboring sectors for track # 'i':
+
+        do jx = ipxmin,ipxmax
+        do jy = ipymin,ipymax
+        do jz = ipzmin,ipzmax
+          trkj_sector = jx + (jy-1)*n_px_bins
+     1                + (jz-1)*n_px_bins*n_py_bins
+          njtrks = 0
+          if(mode.le.3) njtrks = stm_n_trk_sec(trkj_sector)
+          if(mode.eq.4) njtrks = stm2_n_trk_sec(trkj_sector)
+          if(njtrks .gt. 0) then
+
+CCC   Begin Secondary Loop over particles in selected sectors in tables
+CCC   'trk' or 'trk2':
+            do jsec = 1,njtrks
+              if(mode.le.3) j = stm_track_id(jsec,trkj_sector)
+              if(mode.eq.4) j = stm2_track_id(jsec,trkj_sector)
+              if((mode.eq.1 .and. j.lt.i .and. trk_flag(j).eq.0)
+     1       .or.(mode.eq.2 .and. j.ne.i .and. trk_flag(j).eq.0)
+     2       .or.(mode.eq.3 .and. j.ne.i .and. trk_flag(j).eq.0)
+     3       .or.(mode.eq.4 .and. trk2_flag(j).eq.0)) then
+
+CCC   Obtain 1D and 3D relative momenta:
+
+                if(mode.eq.1 .or. mode.eq.3) then
+                  trkj_pid = trk_ge_pid(j)
+                  Call qdiff(trk_px(i),trk_py(i),trk_pz(i),trk_E(i),
+     1                       trk_px(j),trk_py(j),trk_pz(j),trk_E(j),
+     2              qinvar2,qtotal2,qvector2,qside2,qout2,qlong2,
+     3              qperp2,qtime2)
+                else if(mode.eq.2) then
+                  trkj_pid = trk_ge_pid(j)
+                  Call qdiff(px_save,py_save,pz_save,E_save,
+     1                       trk_px(j),trk_py(j),trk_pz(j),trk_E(j),
+     2              qinvar2,qtotal2,qvector2,qside2,qout2,qlong2,
+     3              qperp2,qtime2)
+                else if(mode.eq.4) then
+                  trkj_pid = trk2_ge_pid(j)
+                  Call qdiff(trk_px(i),trk_py(i),trk_pz(i),trk_E(i),
+     1              trk2_px(j),trk2_py(j),trk2_pz(j),trk2_E(j),
+     2              qinvar2,qtotal2,qvector2,qside2,qout2,qlong2,
+     3              qperp2,qtime2)
+                end if
+
+C-----------------------------------------------
+CCC   Fill and/or Update 1D two-body Histograms:
+C-----------------------------------------------
+
+                if(switch_1d .gt. 0) then
+
+                  if(switch_1d .eq. 1) then
+                    qdiff1 = sqrt(qinvar2)
+                  else if(switch_1d .eq. 2) then
+                    qdiff1 = sqrt(qtotal2)
+                  else if(switch_1d .eq. 3) then
+                    qdiff1 = sqrt(qvector2)
+                  else
+                    qdiff1 = sqrt(qvector2)
+                  end if
+
+                  if(qdiff1 .le. qmid_1d) then
+                    index1 = int((qdiff1/binsize_1d_fine)+0.99999)
+                    if(index1 .eq. 0) index1 = 1
+                  else if(qdiff1.gt.qmid_1d.and.qdiff1.le.qmax_1d) then
+                    index1 = int(((qdiff1-qmid_1d)/binsize_1d_coarse)
+     1                     + 0.99999)
+                    if(index1.eq.0) index1 = 1
+                    index1 = index1 + n_1d_fine
+                  else
+                    index1 = -86
+                  end if
+
+                  if(index1.ge.1.and.index1.le.n_1d_total) then
+                    if((trki_pid.eq.trkj_pid).and.(switch_type.eq.1
+     1                  .or. switch_type.eq.3)) then
+                      if(mode.eq.1) then
+                        hist_like_1d(index1) = hist_like_1d(index1) + 1
+                      else if(mode.eq.2) then
+                        htmp_like_1d(index1) = htmp_like_1d(index1) - 1
+                      else if(mode.eq.3) then
+                        htmp_like_1d(index1) = htmp_like_1d(index1) + 1
+                      else if(mode.eq.4) then
+                        href_like_1d(index1) = href_like_1d(index1) + 1
+                      end if
+
+                    else if((trki_pid.ne.trkj_pid).and.(switch_type.eq.2
+     1                       .or. switch_type.eq.3)) then
+                      if(mode.eq.1) then
+                      hist_unlike_1d(index1) = hist_unlike_1d(index1)+1
+                      else if(mode.eq.2) then
+                      htmp_unlike_1d(index1) = htmp_unlike_1d(index1)-1
+                      else if(mode.eq.3) then
+                      htmp_unlike_1d(index1) = htmp_unlike_1d(index1)+1
+                      else if(mode.eq.4) then
+                      href_unlike_1d(index1) = href_unlike_1d(index1)+1
+                      end if
+
+                    end if
+                  end if
+                end if     ! End 1D Histogram Fill and/or Update.
+
+C-----------------------------------------------
+CCC   Fill and/or Update 3D Two-Body Histograms:
+C-----------------------------------------------
+
+                if(switch_3d .gt. 0) then
+                  if(switch_3d .eq. 1) then
+                    qdiff1 = sqrt(qside2)
+                    qdiff2 = sqrt(qout2)
+                    qdiff3 = sqrt(qlong2)
+                  else if(switch_3d .eq. 2) then
+                    qdiff1 = sqrt(qperp2)
+                    qdiff2 = sqrt(qtime2)
+                    qdiff3 = sqrt(qlong2)
+                  else
+                    qdiff1 = sqrt(qperp2)
+                    qdiff2 = sqrt(qtime2)
+                    qdiff3 = sqrt(qlong2)
+                  end if
+
+                  if(qdiff1 .le. qmid_3d) then
+                    findex1 = int((qdiff1/binsize_3d_fine)+0.99999)
+                    if(findex1 .eq. 0) findex1 = 1
+                    index1 = 1
+                  else if(qdiff1.gt.qmid_3d.and.qdiff1.le.qmax_3d) then
+                    index1 = int((qdiff1/binsize_3d_coarse)+0.99999)
+                    if(index1.eq.1) index1 = 2
+                    findex1 = 0
+                  else
+                    index1 = -86
+                    findex1 = -86
+                  end if
+
+                  if(qdiff2 .le. qmid_3d) then
+                    findex2 = int((qdiff2/binsize_3d_fine)+0.99999)
+                    if(findex2 .eq. 0) findex2 = 1
+                    index2 = 1
+                  else if(qdiff2.gt.qmid_3d.and.qdiff2.le.qmax_3d) then
+                    index2 = int((qdiff2/binsize_3d_coarse)+0.99999)
+                    if(index2.eq.1) index2 = 2
+                    findex2 = 0
+                  else
+                    index2 = -86
+                    findex2 = -86
+                  end if
+
+                  if(qdiff3 .le. qmid_3d) then
+                    findex3 = int((qdiff3/binsize_3d_fine)+0.99999)
+                    if(findex3 .eq. 0) findex3 = 1
+                    index3 = 1
+                  else if(qdiff3.gt.qmid_3d.and.qdiff3.le.qmax_3d) then
+                    index3 = int((qdiff3/binsize_3d_coarse)+0.99999)
+                    if(index3.eq.1) index3 = 2
+                    findex3 = 0
+                  else
+                    index3 = -86
+                    findex3 = -86
+                  end if
+
+                  if((index1.ge.1.and.index1.le.n_3d_coarse).and.
+     1               (index2.ge.1.and.index2.le.n_3d_coarse).and.
+     2               (index3.ge.1.and.index3.le.n_3d_coarse)) then
+
+                   if((index1+index2+index3).eq.3) then
+
+                    if(findex1.ge.1.and.findex1.le.n_3d_fine.and.
+     1                 findex2.ge.1.and.findex2.le.n_3d_fine.and.
+     2                 findex3.ge.1.and.findex3.le.n_3d_fine) then
+
+                     if((trki_pid.eq.trkj_pid).and.(switch_type.eq.1
+     1                   .or. switch_type.eq.3)) then
+
+                      if(mode.eq.1) then
+                       hist_like_3d_fine(findex1,findex2,findex3) =
+     1                 hist_like_3d_fine(findex1,findex2,findex3) +1
+                      else if(mode.eq.2) then
+                       htmp_like_3d_fine(findex1,findex2,findex3) =
+     1                 htmp_like_3d_fine(findex1,findex2,findex3) -1
+                      else if(mode.eq.3) then
+                       htmp_like_3d_fine(findex1,findex2,findex3) =
+     1                 htmp_like_3d_fine(findex1,findex2,findex3) +1
+                      else if(mode.eq.4) then
+                       href_like_3d_fine(findex1,findex2,findex3) =
+     1                 href_like_3d_fine(findex1,findex2,findex3) +1
+                      end if
+
+                     else if((trki_pid.ne.trkj_pid).and.(switch_type
+     1                    .eq.2 .or. switch_type.eq.3)) then
+
+                      if(mode.eq.1) then
+                       hist_unlike_3d_fine(findex1,findex2,findex3) =
+     1                 hist_unlike_3d_fine(findex1,findex2,findex3) +1
+                      else if(mode.eq.2) then
+                       htmp_unlike_3d_fine(findex1,findex2,findex3) =
+     1                 htmp_unlike_3d_fine(findex1,findex2,findex3) -1
+                      else if(mode.eq.3) then
+                       htmp_unlike_3d_fine(findex1,findex2,findex3) =
+     1                 htmp_unlike_3d_fine(findex1,findex2,findex3) +1
+                      else if(mode.eq.4) then
+                       href_unlike_3d_fine(findex1,findex2,findex3) =
+     1                 href_unlike_3d_fine(findex1,findex2,findex3) +1
+                      end if
+
+                     end if
+                    end if
+
+                   else if((index1+index2+index3).gt.3) then
+
+                     if((trki_pid.eq.trkj_pid).and.(switch_type.eq.1
+     1                   .or. switch_type.eq.3)) then
+
+                      if(mode.eq.1) then
+                       hist_like_3d_coarse(index1,index2,index3) =
+     1                 hist_like_3d_coarse(index1,index2,index3) +1
+                      else if(mode.eq.2) then
+                       htmp_like_3d_coarse(index1,index2,index3) =
+     1                 htmp_like_3d_coarse(index1,index2,index3) -1
+                      else if(mode.eq.3) then
+                       htmp_like_3d_coarse(index1,index2,index3) =
+     1                 htmp_like_3d_coarse(index1,index2,index3) +1
+                      else if(mode.eq.4) then
+                       href_like_3d_coarse(index1,index2,index3) =
+     1                 href_like_3d_coarse(index1,index2,index3) +1
+                      end if
+
+                     else if((trki_pid.ne.trkj_pid).and.(switch_type
+     1                    .eq.2 .or. switch_type.eq.3)) then
+
+                      if(mode.eq.1) then
+                       hist_unlike_3d_coarse(index1,index2,index3) =
+     1                 hist_unlike_3d_coarse(index1,index2,index3) +1
+                      else if(mode.eq.2) then
+                       htmp_unlike_3d_coarse(index1,index2,index3) =
+     1                 htmp_unlike_3d_coarse(index1,index2,index3) -1
+                      else if(mode.eq.3) then
+                       htmp_unlike_3d_coarse(index1,index2,index3) =
+     1                 htmp_unlike_3d_coarse(index1,index2,index3) +1
+                      else if(mode.eq.4) then
+                       href_unlike_3d_coarse(index1,index2,index3) =
+     1                 href_unlike_3d_coarse(index1,index2,index3) +1
+                      end if
+
+                     end if
+                    end if    ! End 3D Fine/Coarse Grid
+                   end if
+                  end if      ! End 3D Histogram Filling and/or Update
+
+               end if
+               end do         ! End Secondary Track Loop
+
+            end if
+            end do
+            end do
+            end do            ! End Neighboring Sector Loop
+
+         end if
+      end do                  ! End Primary Track Loop
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+
+      subroutine correlation_fit
+      implicit none
+
+CCC   This subroutine carries out the track momentum adjustment
+CCC   procedure in order to fit the requested model correlation
+CCC   function and the input one-body {pt,phi,eta} distributions.
+
+CCC   The method used is similar to the Metropolis method.  Briefly:
+C
+C     1. The accepted tracks for each event in the 'event_text.in'
+C        input file are loaded into the 'trk' data structure table.
+C     2. The sector information, histograms, C2 and initial chi-square
+C        are computed.
+C     3. Each track momentum is randomly shifted within a specified
+C        range, one track at a time, the histograms are updated, and
+C        a new C2 and chi-square are computed.
+C     4. If the new track momentum is acceptable and if it results in a
+C        smaller value of chi-square, then this shifted momentum is
+C        retained, if not then the original momentum value is restored.
+C     5. This is done for all particles in the track table for the event.
+C     6. The entire process is repeated either until the maximum # of
+C        iterations is reached, or until the chi-square improvement with
+C        each iteration diminishes sufficiently.
+C     7. After completing the event loop, summary information is gathered
+C        and inclusive correlation functions and one-body distributions
+C        are calculated.
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_event_summary.inc'
+
+      Include 'common_track.inc'
+      Include 'common_track2.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+      Include 'common_particle.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,j,k,ievent,niter,ntracks_out,nev
+      integer*4 ntracks_flagged,track_status,pid_index
+      integer*4 px_sec_save,py_sec_save,pz_sec_save
+
+      real*4    px_save,py_save,pz_save,E_save
+      real*4    pt_save,phi_save,eta_save,mass
+      real*4    chisq_like_1d,chisq_unlike_1d
+      real*4    chisq_like_3d_fine,chisq_unlike_3d_fine
+      real*4    chisq_like_3d_coarse,chisq_unlike_3d_coarse
+      real*4    chisq_hist1_1,chisq_hist1_2
+      real*4    chisq_total,chisq_total_oldvalue,chisq_total_newvalue
+      real*4    hbtpran
+
+CCC   Initialize counters:
+
+      n_part_used_1_inc    = 0
+      n_part_used_2_inc    = 0
+      num_pairs_like_inc   = 0
+      num_pairs_unlike_inc = 0
+      event_line_counter   = 0
+      file10_line_counter  = 0
+
+CCC   Open event input, track selection flags and event output files:
+
+      If(ALICE .eq. 0) Then
+      open(unit=2,type='old',access='sequential',
+     1     name='event_text.in')
+      open(unit=4,type='old',access='sequential',
+     1     name='event_tracks.select')
+      open(unit=10,status='unknown',access='sequential',
+     1     name='event_hbt_text.out')
+CCC   Read/Write event header from/to I/O event text files
+         Call read_data(7)
+         Call read_data(8)
+      End If
+
+C-------------------------------------
+C  Begin Event Loop, 
+C
+      do ievent = 2, n_events + 1   
+C-------------------------------------
+
+        If(ALICE .eq. 1) Then
+           Call AliHbtp_SetActiveEventNumber(ievent-1)
+           write(*,*) 'NEXT EVENT:', ievent
+        End If
+        Call read_data(7)
+        if(n_part_tot_trk .gt. 0) then
+
+          write(6,98)
+          Call tindex(1,0)  !  Fill initial track-sector info.
+          Call stm_build(1,0,0)  ! Fill initial sector info.
+          Call dist_range(1,ntracks_out,ntracks_flagged)
+          num_pairs_like = (n_part_used_1_trk*(n_part_used_1_trk-1))/2
+     1                   + (n_part_used_2_trk*(n_part_used_2_trk-1))/2
+          num_pairs_unlike = n_part_used_1_trk*n_part_used_2_trk
+          num_pairs_like_inc = num_pairs_like_inc + num_pairs_like
+          num_pairs_unlike_inc = num_pairs_unlike_inc + num_pairs_unlike
+          n_part_used_1_inc = n_part_used_1_inc + n_part_used_1_trk
+          n_part_used_2_inc = n_part_used_2_inc + n_part_used_2_trk
+          if(pid(1).gt.0) Call histog1(1,0,1,pid(1),0.,0.,0.)
+          if(pid(2).gt.0) Call histog1(1,0,2,pid(2),0.,0.,0.)
+          Call histog2(1,0,0,0,0,0.0,0.0,0.0,0.0)
+          Call correl_fit(1)
+          Call chisquare(1,chisq_like_1d,chisq_unlike_1d,
+     1                   chisq_like_3d_fine,chisq_unlike_3d_fine,
+     2                   chisq_like_3d_coarse,chisq_unlike_3d_coarse,
+     3                   chisq_hist1_1,chisq_hist1_2)
+          chisq_total = chisq_wt_like_1d    *chisq_like_1d
+     1                + chisq_wt_unlike_1d  *chisq_unlike_1d
+     2         + chisq_wt_like_3d_fine      *chisq_like_3d_fine
+     3         + chisq_wt_unlike_3d_fine    *chisq_unlike_3d_fine
+     4         + chisq_wt_like_3d_coarse    *chisq_like_3d_coarse
+     5         + chisq_wt_unlike_3d_coarse  *chisq_unlike_3d_coarse
+     6         + chisq_wt_hist1_1           *chisq_hist1_1
+     7         + chisq_wt_hist1_2           *chisq_hist1_2
+          chisq_total_oldvalue = chisq_total
+          Call hist1_copy(1)
+          Call hist2_copy(1)
+
+          niter = 0
+1000      Continue       ! Starting Point for Track Shift Iteration Loop:
+          niter = niter + 1
+
+          if(niter.eq.1) then
+             write(8,99)
+             write(8,98)
+             write(8,99)
+          end if
+98        Format(5x,'**  START NEXT EVENT  **')
+99        Format(5x,'************************')
+          write(8,100) ievent,niter,chisq_total
+100       Format(10x,'Event#+1,Iteration# and Chi-Sq = ',2I5,E11.4)
+
+          IF(maxit .eq. 0) GO TO 1001   ! Option to compute correlations
+C                                       ! for input events.
+
+C-------------------------------------
+C  Begin Track Adjustment Loop:
+
+          do i = 1,n_part_tot_trk   
+C-------------------------------------
+
+          if(trk_flag(i) .eq. 0) then
+
+CCC   Save initial track parameters (those that might change):
+
+          px_save      = trk_px(i)
+          py_save      = trk_py(i)
+          pz_save      = trk_pz(i)
+          E_save       = trk_E(i)
+          pt_save      = trk_pt(i)
+          phi_save     = trk_phi(i)
+          eta_save     = trk_eta(i)
+          px_sec_save  = trk_px_sec(i)
+          py_sec_save  = trk_py_sec(i)
+          pz_sec_save  = trk_pz_sec(i)
+          old_sec_save = trk_sector(i)
+
+CCC   Save the sector values that the track is initially located in:
+
+          old_sec_ntrk = stm_n_trk_sec(trk_sector(i))
+          old_sec_flag = stm_flag(trk_sector(i))
+          do k = 1,stm_n_trk_sec(trk_sector(i))
+            old_sec_trkid(k) = stm_track_id(k,trk_sector(i))
+          end do
+
+CCC   Determine the particle ID type:
+
+          if(trk_ge_pid(i).eq.pid(1) .and. pid(1).gt.0) then
+            pid_index = 1
+          else if(trk_ge_pid(i).eq.pid(2).and.pid(2).gt.0) then
+            pid_index = 2
+          else
+            pid_index = 1
+          end if
+
+CCC   Randomly shift track momentum vector and compute new kinematics:
+
+          trk_px(i) = trk_px(i) + deltap*(2.0*hbtpran(irand) - 1.0)
+          trk_py(i) = trk_py(i) + deltap*(2.0*hbtpran(irand) - 1.0)
+          trk_pz(i) = trk_pz(i) + deltap*(2.0*hbtpran(irand) - 1.0)
+          mass = part_mass(trk_ge_pid(i))
+          Call Hbtp_kin(trk_px(i),trk_py(i),trk_pz(i),trk_E(i),
+     1                    trk_pt(i),trk_phi(i),trk_eta(i),mass,1)
+          Call tindex(1,i)
+          new_sec_save = trk_sector(i)
+
+CCC   Determine if track has been shifted to a new sector, and if so,
+CCC   whether this overfills this new sector.  If all is well, then
+CCC   update histograms.  If not, then restore track parameters to their
+CCC   initial values prior to shifting.  Keep the status of track(i) in
+CCC   'track_status', where a value of 0 means the track is OK to use.
+CCC
+CCC   The Logical steps are the following:
+CCC
+C     IF(new track position is in same sector) THEN
+C       o Remove old track position from htmp1*, htmp* using old saved values.
+C       o Add new track position to htmp1*, htmp* using values in 'trk'
+C         (Sector information is unchanged)
+C     ELSE IF(new track position is in a different sector) THEN
+C       IF(# tracks in new sector is still OK, with the new track) THEN 
+C         o Save values of new sector before trk was shifted into it.
+C         o Remove old trk position from htmp1*, htmp* using old saved values
+C         o Add new trk position to htmp1*, htmp* using values in trk
+C         o Update sector information in stm
+C       ELSE IF(# tracks in new sector becomes too many with new trk) THEN
+C         o Restore track parameters to pre-shifted values
+C         o Set track_status = 1, indicating the track could not be moved
+C       END IF
+C     END IF
+
+          track_status = 0
+          if(old_sec_save .eq. new_sec_save) then
+            Call histog1(2,i,pid_index,pid(pid_index),pt_save,
+     1                   phi_save,eta_save)
+            Call histog2(2,i,px_sec_save,py_sec_save,pz_sec_save,
+     1           px_save,py_save,pz_save,E_save)
+
+            Call histog1(3,i,pid_index,pid(pid_index),0.,0.,0.)
+            Call histog2(3,i,0,0,0,0.0,0.0,0.0,0.0)
+
+          else if(old_sec_save .ne. new_sec_save) then
+
+            if(stm_n_trk_sec(new_sec_save) .lt. max_trk_sec) then
+              new_sec_ntrk = stm_n_trk_sec(new_sec_save)
+              new_sec_flag = stm_flag(new_sec_save)
+              if(new_sec_ntrk .gt. 0) then
+                do k = 1,new_sec_ntrk
+                  new_sec_trkid(k) = stm_track_id(k,new_sec_save)
+                end do
+              end if
+
+              Call histog1(2,i,pid_index,pid(pid_index),pt_save,
+     1                   phi_save,eta_save)
+              Call histog2(2,i,px_sec_save,py_sec_save,pz_sec_save,
+     1           px_save,py_save,pz_save,E_save)
+
+              Call histog1(3,i,pid_index,pid(pid_index),
+     1           0.,0.,0.)
+              Call histog2(3,i,0,0,0,0.0,0.0,0.0,0.0)
+
+              Call stm_build(1,i,old_sec_save)
+           
+            else if(stm_n_trk_sec(new_sec_save) .ge. max_trk_sec) then
+     
+              track_status = 1
+              trk_px(i)      = px_save
+              trk_py(i)      = py_save
+              trk_pz(i)      = pz_save
+              trk_E(i)       = E_save
+              trk_pt(i)      = pt_save
+              trk_phi(i)     = phi_save
+              trk_eta(i)     = eta_save
+              trk_px_sec(i)  = px_sec_save
+              trk_py_sec(i)  = py_sec_save
+              trk_pz_sec(i)  = pz_sec_save
+              trk_sector(i)  = old_sec_save
+
+            end if
+          end if        ! End Histogram and Sector Update
+
+CCC   If the track was succesfully shifted then compute C2 and determine
+C     if the chi-square decreases (improves) or increases.  If it improves,
+C     then store the new chi-square value and keep the 1- and 2-body
+C     histograms in hist1* and hist*, repsectively.  If chi-square
+C     increases (worsens), then restore the track parameters to the
+C     pre-shifted values, restore the histograms and if a new sector was
+C     involved, then restore both the old and new sector values.
+C
+C     The Logical steps are the following:
+C
+C     IF(new track position is OK, (i.e. track_status = 0)) Then
+C       o Compute C2 using htmp*
+C       o Compute chi-square and save
+C       IF(chi-square improves) Then
+C         o Replace previous (best) chi-square with new value
+C         o Update histograms, i.e. copy htmp1* -> hist1* and
+C                                   copy htmp*  -> hist*
+C       ELSE IF(chi-square increases) Then
+C         o Restore track parameters
+C         o Restore histograms, i.e. copy hist1* -> htmp1* and
+C                                    copy hist*  -> htmp*
+C         IF(new sector was used) Then
+C           o Restore old sector values to pre-shifted values
+C           o Restore new sector values to pre-shifted values
+C         END IF
+C       END IF
+C     END IF
+
+          If(track_status .eq.0) Then
+            Call correl_fit(2)                   
+            Call chisquare(2,chisq_like_1d,chisq_unlike_1d,
+     1                     chisq_like_3d_fine,chisq_unlike_3d_fine,
+     2                     chisq_like_3d_coarse,chisq_unlike_3d_coarse,
+     3                     chisq_hist1_1,chisq_hist1_2)
+            chisq_total_newvalue =
+     1         chisq_wt_like_1d           *chisq_like_1d
+     2       + chisq_wt_unlike_1d         *chisq_unlike_1d
+     3       + chisq_wt_like_3d_fine      *chisq_like_3d_fine
+     4       + chisq_wt_unlike_3d_fine    *chisq_unlike_3d_fine
+     5       + chisq_wt_like_3d_coarse    *chisq_like_3d_coarse
+     6       + chisq_wt_unlike_3d_coarse  *chisq_unlike_3d_coarse
+     7       + chisq_wt_hist1_1           *chisq_hist1_1
+     8       + chisq_wt_hist1_2           *chisq_hist1_2
+
+            if(chisq_total_newvalue .lt. chisq_total_oldvalue) then
+              chisq_total_oldvalue = chisq_total_newvalue
+              Call hist1_copy(2)
+              Call hist2_copy(2)
+            else if(chisq_total_newvalue.ge.chisq_total_oldvalue) then
+              trk_px(i)      = px_save
+              trk_py(i)      = py_save
+              trk_pz(i)      = pz_save
+              trk_E(i)       = E_save
+              trk_pt(i)      = pt_save
+              trk_phi(i)     = phi_save
+              trk_eta(i)     = eta_save
+              trk_px_sec(i)  = px_sec_save
+              trk_py_sec(i)  = py_sec_save
+              trk_pz_sec(i)  = pz_sec_save
+              trk_sector(i)  = old_sec_save
+              Call hist1_copy(1)
+              Call hist2_copy(1)
+
+              If(old_sec_save .ne. new_sec_save) then
+
+                stm_n_trk_sec(old_sec_save) = old_sec_ntrk
+                stm_flag(old_sec_save)      = old_sec_flag
+                do k = 1,max_trk_sec
+                  stm_track_id(k,old_sec_save) = 0
+                end do
+                do k = 1,old_sec_ntrk
+                  stm_track_id(k,old_sec_save) = old_sec_trkid(k)
+                end do
+
+                stm_n_trk_sec(new_sec_save) = new_sec_ntrk
+                stm_flag(new_sec_save)      = new_sec_flag
+                do k = 1,max_trk_sec
+                  stm_track_id(k,new_sec_save) = 0
+                end do
+                do k = 1,new_sec_ntrk
+                  stm_track_id(k,new_sec_save) = new_sec_trkid(k)
+                end do
+
+              end if
+            end if
+          end if         ! End Chi-Square Determination
+        end if           ! End valid tracks option
+        end do           ! End Track Shift Loop
+
+CCC   Check chi-square for this iteration --
+C        Best, current chi-square value is in 'chisq_total_oldvalue'
+C        Chi-square value at the beginning of the iteration loop is in
+C        'chisq_total'.
+
+        If(abs(200.0*(chisq_total_oldvalue - chisq_total)/
+     1    (chisq_total_oldvalue + chisq_total)) .lt. delchi) then
+          write(8,101)
+101       Format(/5x,'Chi-Sq reduced .lt. delchi % on last iteration',
+     1           ' - Stop Search')
+          go to 1001
+        End If
+        If (niter .gt. maxit) Then
+          write(8,102)
+102       Format(/5x,'Max # Search Iterations Reached - Abort track ',
+     1           'Adj. process')
+          go to 1001
+        End If
+        chisq_total = chisq_total_oldvalue
+        go to 1000
+
+1001    Continue
+
+CCC   Finished Track Adjustment Iteration Loop for event # 'ievent'
+
+        if((ievent - 1) .le. max_events) then
+          Call dist_range(1,ntracks_out,ntracks_flagged)
+          num_iter(ievent-1) = float(niter)
+          n_part_used_1_store(ievent-1) = float(n_part_used_1_trk)
+          n_part_used_2_store(ievent-1) = float(n_part_used_2_trk)
+          n_part_tot_store(ievent-1) = float(n_part_tot_trk)
+          frac_trks_out(ievent-1)=float(ntracks_out)/
+     1                            float(n_part_tot_trk)
+          frac_trks_flag(ievent-1) = 
+     1         float(ntracks_flagged)/float(n_part_tot_trk)
+        end if
+       
+        Call correl_fit(1)
+        Call chisquare(1,chisq_like_1d,chisq_unlike_1d,
+     1                 chisq_like_3d_fine,chisq_unlike_3d_fine,
+     2                 chisq_like_3d_coarse,chisq_unlike_3d_coarse,
+     3                 chisq_hist1_1,chisq_hist1_2)
+        chisq_total = chisq_wt_like_1d    *chisq_like_1d
+     1              + chisq_wt_unlike_1d  *chisq_unlike_1d
+     2       + chisq_wt_like_3d_fine      *chisq_like_3d_fine
+     3       + chisq_wt_unlike_3d_fine    *chisq_unlike_3d_fine
+     4       + chisq_wt_like_3d_coarse    *chisq_like_3d_coarse
+     5       + chisq_wt_unlike_3d_coarse  *chisq_unlike_3d_coarse
+     6       + chisq_wt_hist1_1           *chisq_hist1_1
+     7       + chisq_wt_hist1_2           *chisq_hist1_2
+
+        if((ievent - 1) .le. max_events) then
+          chisq_like_1d_store(ievent-1)          = chisq_like_1d
+          chisq_unlike_1d_store(ievent-1)        = chisq_unlike_1d
+          chisq_like_3d_fine_store(ievent-1)     = chisq_like_3d_fine
+          chisq_unlike_3d_fine_store(ievent-1)   = chisq_unlike_3d_fine
+          chisq_like_3d_coarse_store(ievent-1)   = chisq_like_3d_coarse
+          chisq_unlike_3d_coarse_store(ievent-1) =chisq_unlike_3d_coarse
+          chisq_hist1_1_store(ievent-1)          = chisq_hist1_1
+          chisq_hist1_2_store(ievent-1)          = chisq_hist1_2
+          chisq_total_store(ievent-1)            = chisq_total
+
+CCC   Count # sectors with stm().flag = 1, indicating that too many 
+C     tracks were attempted to be loaded into that sector.
+
+          num_sec_flagged_store(ievent-1) = 0.0
+          do k = 1,n_sectors
+            if(stm_flag(k) .eq. 1) then
+              num_sec_flagged_store(ievent-1) = 
+     1             num_sec_flagged_store(ievent-1) + 1.0
+            end if
+          end do
+        end if
+
+        Call hist1_incl_sum
+        Call hist2_incl_sum
+        if(print_full .eq. 1) Call write_data(5,ievent-1)
+
+      end if    !  End event-with-tracks processing.
+        Call read_data(8)
+
+C-------------------------------
+      end do    ! End Event Loop
+C-------------------------------
+
+CCC   Compute Correlation Functions for the Inclusive Histograms
+
+      Call correl_fit(3)
+
+CCC   Compute Mean and Std. dev of event monitor and summary quantities:
+
+      if(n_events .le. max_events) then
+         nev = n_events
+      else
+         nev = max_events
+      end if
+
+      Call mean_rms(num_iter,nev,nev,niter_mean,niter_rms)
+      Call mean_rms(n_part_used_1_store,nev,nev,npart1_mean,npart1_rms)
+      Call mean_rms(n_part_used_2_store,nev,nev,npart2_mean,npart2_rms)
+      Call mean_rms(n_part_tot_store,nev,nev,npart_tot_mean,
+     1              npart_tot_rms)
+      Call mean_rms(num_sec_flagged_store,nev,nev,
+     1              nsec_flag_mean,nsec_flag_rms)
+      Call mean_rms(frac_trks_out,nev,nev,
+     1              frac_trks_out_mean,frac_trks_out_rms)
+      Call mean_rms(frac_trks_flag,nev,nev,
+     1              frac_trks_flag_mean,frac_trks_flag_rms)
+      Call mean_rms(chisq_like_1d_store,nev,nev,
+     1              chi_l1d_mean,chi_l1d_rms)
+      Call mean_rms(chisq_unlike_1d_store,nev,nev,
+     1              chi_u1d_mean,chi_u1d_rms)
+      Call mean_rms(chisq_like_3d_fine_store,nev,nev,
+     1              chi_l3f_mean,chi_l3f_rms)
+      Call mean_rms(chisq_unlike_3d_fine_store,nev,nev,
+     1              chi_u3f_mean,chi_u3f_rms)
+      Call mean_rms(chisq_like_3d_coarse_store,nev,nev,
+     1              chi_l3c_mean,chi_l3c_rms)
+      Call mean_rms(chisq_unlike_3d_coarse_store,nev,nev,
+     1              chi_u3c_mean,chi_u3c_rms)
+      Call mean_rms(chisq_hist1_1_store,nev,nev,
+     1              chi_1_1_mean, chi_1_1_rms)
+      Call mean_rms(chisq_hist1_2_store,nev,nev,
+     1              chi_1_2_mean, chi_1_2_rms)
+      Call mean_rms(chisq_total_store,nev,nev,
+     1              chi_tot_mean, chi_tot_rms)
+
+      If(ALICE .eq. 0) Then
+      Close(unit=2)
+      Close(unit=4)
+      Close(unit=10)
+      End If
+
+      Return
+      END
+
+C------------------------------------------------------------------------
+
+
+      subroutine hist1_copy(mode)
+      implicit none
+
+CCC   Copy 1-body histograms if:
+CCC
+CCC   mode = 1, then copy hist1* -> htmp1*
+CCC   mode = 2, then copy htmp1* -> hist1*
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4  mode, i
+
+C---------------------------
+      If(mode .eq. 1) Then       !  Copy hist1* -> htmp1*
+C---------------------------
+
+        if(pid(1) .gt. 0) then
+          do i = 1,n_pt_bins
+            htmp1_pt_1(i)  = hist1_pt_1(i)
+          end do
+          do i = 1,n_phi_bins
+            htmp1_phi_1(i) = hist1_phi_1(i)
+          end do
+          do i = 1,n_eta_bins
+            htmp1_eta_1(i) = hist1_eta_1(i)
+          end do
+        end if
+
+        if(pid(2) .gt. 0) then
+          do i = 1,n_pt_bins     
+            htmp1_pt_2(i)  = hist1_pt_2(i)
+          end do
+          do i = 1,n_phi_bins
+            htmp1_phi_2(i) = hist1_phi_2(i)
+          end do
+          do i = 1,n_eta_bins
+            htmp1_eta_2(i) = hist1_eta_2(i)
+          end do
+        end if
+     
+C--------------------------------
+      Else If (mode .eq. 2) Then   ! Copy htmp1* -> hist1*
+C--------------------------------
+
+        if(pid(1) .gt. 0) then
+          do i = 1,n_pt_bins     
+            hist1_pt_1(i)  = htmp1_pt_1(i)
+          end do
+          do i = 1,n_phi_bins
+            hist1_phi_1(i) = htmp1_phi_1(i)
+          end do
+          do i = 1,n_eta_bins
+            hist1_eta_1(i) = htmp1_eta_1(i)
+          end do
+        end if
+
+        if(pid(2) .gt. 0) then
+          do i = 1,n_pt_bins     
+            hist1_pt_2(i)  = htmp1_pt_2(i)
+          end do
+          do i = 1,n_phi_bins
+            hist1_phi_2(i) = htmp1_phi_2(i)
+          end do
+          do i = 1,n_eta_bins
+            hist1_eta_2(i) = htmp1_eta_2(i)
+          end do
+        end if 
+
+C------------
+      End If
+C------------
+
+      Return
+      END
+
+C----------------------------------------------------------------------
+
+      subroutine hist2_copy(mode)
+      implicit none
+
+CCC   Copy 2-body histograms if:
+CCC
+CCC   mode = 1, then copy hist* -> htmp*
+CCC   mode = 2, then copy htmp* -> hist*
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4  mode, i,j,k
+
+C---------------------------
+      If (mode .eq. 1) Then    !   Copy hist* -> htmp*
+C---------------------------
+
+        if(switch_1d.gt.0 .and. n_1d_total.gt.0) then
+          if(switch_type.eq.1 .or. switch_type.eq.3) then
+            do i = 1,n_1d_total
+              htmp_like_1d(i) = hist_like_1d(i)
+            end do
+          end if
+          if(switch_type.eq.2 .or. switch_type.eq.3) then
+            do i = 1,n_1d_total
+              htmp_unlike_1d(i) = hist_unlike_1d(i)
+            end do
+          end if
+        end if     ! End 1D histogram copy
+
+        if(switch_3d.gt.0) then
+          if(switch_type.eq.1 .or. switch_type.eq.3) then
+
+            if(n_3d_fine .gt. 0) then
+              do i = 1,n_3d_fine
+              do j = 1,n_3d_fine
+              do k = 1,n_3d_fine
+                htmp_like_3d_fine(i,j,k) = hist_like_3d_fine(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+            if(n_3d_coarse .gt. 0) then
+              do i = 1,n_3d_coarse
+              do j = 1,n_3d_coarse
+              do k = 1,n_3d_coarse
+                htmp_like_3d_coarse(i,j,k) = hist_like_3d_coarse(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+          end if
+
+          if(switch_type.eq.2 .or. switch_type.eq.3) then
+
+            if(n_3d_fine .gt. 0) then
+              do i = 1,n_3d_fine
+              do j = 1,n_3d_fine
+              do k = 1,n_3d_fine
+                htmp_unlike_3d_fine(i,j,k) = hist_unlike_3d_fine(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+            if(n_3d_coarse .gt. 0) then
+              do i = 1,n_3d_coarse
+              do j = 1,n_3d_coarse
+              do k = 1,n_3d_coarse
+               htmp_unlike_3d_coarse(i,j,k)=hist_unlike_3d_coarse(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+          end if
+        end if     ! End 3D histogram copy
+
+C--------------------------------
+      Else If (mode .eq. 2) Then   !   Copy htmp* -> hist*
+C--------------------------------
+
+        if(switch_1d.gt.0 .and. n_1d_total.gt.0) then
+          if(switch_type.eq.1 .or. switch_type.eq.3) then
+            do i = 1,n_1d_total
+              hist_like_1d(i) = htmp_like_1d(i)
+            end do
+          end if
+          if(switch_type.eq.2 .or. switch_type.eq.3) then
+            do i = 1,n_1d_total
+              hist_unlike_1d(i) = htmp_unlike_1d(i)
+            end do
+          end if
+        end if     ! End 1D histogram copy
+
+        if(switch_3d.gt.0) then
+          if(switch_type.eq.1 .or. switch_type.eq.3) then
+
+            if(n_3d_fine .gt. 0) then
+              do i = 1,n_3d_fine
+              do j = 1,n_3d_fine
+              do k = 1,n_3d_fine
+                hist_like_3d_fine(i,j,k) = htmp_like_3d_fine(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+            if(n_3d_coarse .gt. 0) then
+              do i = 1,n_3d_coarse
+              do j = 1,n_3d_coarse
+              do k = 1,n_3d_coarse
+                hist_like_3d_coarse(i,j,k) = htmp_like_3d_coarse(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+          end if
+
+          if(switch_type.eq.2 .or. switch_type.eq.3) then
+
+            if(n_3d_fine .gt. 0) then
+              do i = 1,n_3d_fine
+              do j = 1,n_3d_fine
+              do k = 1,n_3d_fine
+                hist_unlike_3d_fine(i,j,k) = htmp_unlike_3d_fine(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+            if(n_3d_coarse .gt. 0) then
+              do i = 1,n_3d_coarse
+              do j = 1,n_3d_coarse
+              do k = 1,n_3d_coarse
+               hist_unlike_3d_coarse(i,j,k)=htmp_unlike_3d_coarse(i,j,k)
+              end do
+              end do
+              end do
+            end if
+
+          end if
+        end if     ! End 3D histogram copy
+
+C-------------
+      End If       ! End mode selection options
+C-------------
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+
+      subroutine hist1_incl_sum
+      implicit none
+
+CCC   Sum 1-body histograms for each event into inclusive totals, where
+CCC   hinc1* = SUM[hist1*]
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i
+
+      if(pid(1) .gt. 0) then
+        do i = 1,n_pt_bins
+          hinc1_pt_1(i) = hinc1_pt_1(i) + hist1_pt_1(i)
+        end do
+        do i = 1,n_phi_bins
+          hinc1_phi_1(i) = hinc1_phi_1(i) + hist1_phi_1(i)
+        end do
+        do i = 1,n_eta_bins
+          hinc1_eta_1(i) = hinc1_eta_1(i) + hist1_eta_1(i)
+        end do
+      end if
+
+      if(pid(2) .gt. 0) then
+        do i = 1,n_pt_bins
+          hinc1_pt_2(i) = hinc1_pt_2(i) + hist1_pt_2(i)
+        end do
+        do i = 1,n_phi_bins
+          hinc1_phi_2(i) = hinc1_phi_2(i) + hist1_phi_2(i)
+        end do
+        do i = 1,n_eta_bins
+          hinc1_eta_2(i) = hinc1_eta_2(i) + hist1_eta_2(i)
+        end do
+      end if
+
+      Return
+      END
+
+
+C------------------------------------------------------------------------
+
+
+      subroutine hist2_incl_sum
+      implicit none
+
+CCC   Sum 2-body histograms for each event into inclusive totals, where
+CCC   hinc* = SUM[hist*]
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,j,k
+
+      if(switch_1d.gt.0 .and. n_1d_total.gt.0) then
+        if(switch_type.eq.1 .or. switch_type.eq.3) then
+          do i = 1,n_1d_total
+            hinc_like_1d(i) = hinc_like_1d(i) + hist_like_1d(i)
+          end do
+        end if
+        if(switch_type.eq.2 .or. switch_type.eq.3) then
+          do i = 1,n_1d_total
+            hinc_unlike_1d(i) = hinc_unlike_1d(i) + hist_unlike_1d(i)
+          end do
+        end if
+      end if      ! End 1D Inclusive Histogram Sum
+
+      if(switch_3d.gt.0) then
+        if(switch_type.eq.1 .or. switch_type.eq.3) then
+
+          if(n_3d_fine .gt. 0) then
+            do i = 1,n_3d_fine
+            do j = 1,n_3d_fine
+            do k = 1,n_3d_fine
+              hinc_like_3d_fine(i,j,k) = hinc_like_3d_fine(i,j,k)
+     1                                 + hist_like_3d_fine(i,j,k)
+            end do
+            end do
+            end do
+          end if
+
+          if(n_3d_coarse .gt. 0) then
+            do i = 1,n_3d_coarse
+            do j = 1,n_3d_coarse
+            do k = 1,n_3d_coarse
+              hinc_like_3d_coarse(i,j,k) = hinc_like_3d_coarse(i,j,k)
+     1                                   + hist_like_3d_coarse(i,j,k)
+            end do
+            end do
+            end do
+          end if
+
+        end if
+
+        if(switch_type.eq.2 .or. switch_type.eq.3) then
+
+          if(n_3d_fine .gt. 0) then
+            do i = 1,n_3d_fine
+            do j = 1,n_3d_fine
+            do k = 1,n_3d_fine
+              hinc_unlike_3d_fine(i,j,k) = hinc_unlike_3d_fine(i,j,k)
+     1                                   + hist_unlike_3d_fine(i,j,k)
+            end do
+            end do
+            end do
+          end if
+
+          if(n_3d_coarse .gt. 0) then
+            do i = 1,n_3d_coarse
+            do j = 1,n_3d_coarse
+            do k = 1,n_3d_coarse
+             hinc_unlike_3d_coarse(i,j,k) = hinc_unlike_3d_coarse(i,j,k)
+     1                                    + hist_unlike_3d_coarse(i,j,k)
+            end do
+            end do
+            end do
+          end if
+
+        end if
+      end if      ! End 3D Inclusive Histogram Sum
+
+      Return
+      END
+
+C--------------------------------------------------------------------------
+
+
+      subroutine correl_fit(mode)
+      implicit none
+
+CCC   This subroutine calculates the 2-body correlation function with
+CCC   errors for the cases:
+CCC
+CCC      (1) 1D and/or 3D fine and coarse grid distributions
+CCC      (2) like pairs and/or unlike pairs
+CCC
+CCC   Uses the signal and reference histograms.  The input parameter
+CCC   'mode' selects which histograms to use.
+CCC
+CCC      Mode = 1, use hist*
+CCC      Mode = 2, use htmp*
+CCC      Mode = 3, use hinc*
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 mode,i,j,k
+
+CCC   Initialize correlation functions and error arrays to zero: 
+
+      do i = 1,max_c2_1d
+         c2fit_like_1d(i)   = 0.0
+         c2fit_unlike_1d(i) = 0.0
+         c2err_like_1d(i)   = 0.0
+         c2err_unlike_1d(i) = 0.0
+      end do
+
+      do i = 1,max_c2_3d
+      do j = 1,max_c2_3d
+      do k = 1,max_c2_3d
+         c2fit_like_3d_fine(i,j,k)     = 0.0
+         c2fit_unlike_3d_fine(i,j,k)   = 0.0
+         c2fit_like_3d_coarse(i,j,k)   = 0.0
+         c2fit_unlike_3d_coarse(i,j,k) = 0.0
+         c2err_like_3d_fine(i,j,k)     = 0.0
+         c2err_unlike_3d_fine(i,j,k)   = 0.0
+         c2err_like_3d_coarse(i,j,k)   = 0.0
+         c2err_unlike_3d_coarse(i,j,k) = 0.0
+      end do
+      end do
+      end do
+
+CCC   Compute 1D Correlation Functions and Errors:
+
+      if(switch_1d .gt. 0) then
+        if(switch_type.eq.1 .or. switch_type.eq.3) then
+
+          if(mode .eq. 1) then
+            Call c2_1d(hist_like_1d,href_like_1d,c2fit_like_1d,
+     1           c2err_like_1d,max_h_1d,max_c2_1d,n_1d_total,
+     2           num_pairs_like,num_pairs_like_ref)
+          else if (mode .eq. 2) then
+            Call c2_1d(htmp_like_1d,href_like_1d,c2fit_like_1d,
+     1           c2err_like_1d,max_h_1d,max_c2_1d,n_1d_total,
+     2           num_pairs_like,num_pairs_like_ref)
+          else if (mode .eq. 3) then
+            Call c2_1d(hinc_like_1d,href_like_1d,c2fit_like_1d,
+     1           c2err_like_1d,max_h_1d,max_c2_1d,n_1d_total,
+     2           num_pairs_like_inc,num_pairs_like_ref)
+          end if
+
+        end if
+
+        if(switch_type.eq.2 .or. switch_type.eq.3) then
+
+          if(mode .eq. 1) then
+            Call c2_1d(hist_unlike_1d,href_unlike_1d,c2fit_unlike_1d,
+     1           c2err_unlike_1d,max_h_1d,max_c2_1d,n_1d_total,
+     2           num_pairs_unlike,num_pairs_unlike_ref)
+          else if (mode .eq. 2) then
+            Call c2_1d(htmp_unlike_1d,href_unlike_1d,c2fit_unlike_1d,
+     1           c2err_unlike_1d,max_h_1d,max_c2_1d,n_1d_total,
+     2           num_pairs_unlike,num_pairs_unlike_ref)
+          else if (mode .eq. 3) then
+            Call c2_1d(hinc_unlike_1d,href_unlike_1d,c2fit_unlike_1d,
+     1           c2err_unlike_1d,max_h_1d,max_c2_1d,n_1d_total,
+     2           num_pairs_unlike_inc,num_pairs_unlike_ref)
+          end if
+        end if
+      end if        ! End 1D correlations
+
+CCC   Compute 3D Correlation Functions and Errors:
+
+      if(switch_3d .gt. 0) then
+        if(switch_type.eq.1 .or. switch_type.eq.3) then
+
+          if(mode .eq. 1) then
+            Call c2_3d(hist_like_3d_fine,href_like_3d_fine,
+     1           c2fit_like_3d_fine,c2err_like_3d_fine,
+     2           max_h_3d,max_c2_3d,n_3d_fine,
+     3           num_pairs_like,num_pairs_like_ref)
+            Call c2_3d(hist_like_3d_coarse,href_like_3d_coarse,
+     1           c2fit_like_3d_coarse,c2err_like_3d_coarse,
+     2           max_h_3d,max_c2_3d,n_3d_coarse,
+     3           num_pairs_like,num_pairs_like_ref)
+          else if(mode .eq. 2) then
+            Call c2_3d(htmp_like_3d_fine,href_like_3d_fine,
+     1           c2fit_like_3d_fine,c2err_like_3d_fine,
+     2           max_h_3d,max_c2_3d,n_3d_fine,
+     3           num_pairs_like,num_pairs_like_ref)
+            Call c2_3d(htmp_like_3d_coarse,href_like_3d_coarse,
+     1           c2fit_like_3d_coarse,c2err_like_3d_coarse,
+     2           max_h_3d,max_c2_3d,n_3d_coarse,
+     3           num_pairs_like,num_pairs_like_ref)
+          else if(mode .eq. 3) then
+            Call c2_3d(hinc_like_3d_fine,href_like_3d_fine,
+     1           c2fit_like_3d_fine,c2err_like_3d_fine,
+     2           max_h_3d,max_c2_3d,n_3d_fine,
+     3           num_pairs_like_inc,num_pairs_like_ref)
+            Call c2_3d(hinc_like_3d_coarse,href_like_3d_coarse,
+     1           c2fit_like_3d_coarse,c2err_like_3d_coarse,
+     2           max_h_3d,max_c2_3d,n_3d_coarse,
+     3           num_pairs_like_inc,num_pairs_like_ref)
+          end if
+
+        end if
+
+        if(switch_type.eq.2 .or. switch_type.eq.3) then
+
+          if(mode .eq. 1) then
+            Call c2_3d(hist_unlike_3d_fine,href_unlike_3d_fine,
+     1           c2fit_unlike_3d_fine,c2err_unlike_3d_fine,
+     2           max_h_3d,max_c2_3d,n_3d_fine,
+     3           num_pairs_unlike,num_pairs_unlike_ref)
+            Call c2_3d(hist_unlike_3d_coarse,href_unlike_3d_coarse,
+     1           c2fit_unlike_3d_coarse,c2err_unlike_3d_coarse,
+     2           max_h_3d,max_c2_3d,n_3d_coarse,
+     3           num_pairs_unlike,num_pairs_unlike_ref)
+          else if(mode .eq. 2) then
+            Call c2_3d(htmp_unlike_3d_fine,href_unlike_3d_fine,
+     1           c2fit_unlike_3d_fine,c2err_unlike_3d_fine,
+     2           max_h_3d,max_c2_3d,n_3d_fine,
+     3           num_pairs_unlike,num_pairs_unlike_ref)
+            Call c2_3d(htmp_unlike_3d_coarse,href_unlike_3d_coarse,
+     1           c2fit_unlike_3d_coarse,c2err_unlike_3d_coarse,
+     2           max_h_3d,max_c2_3d,n_3d_coarse,
+     3           num_pairs_unlike,num_pairs_unlike_ref)
+          else if(mode .eq. 3) then
+            Call c2_3d(hinc_unlike_3d_fine,href_unlike_3d_fine,
+     1           c2fit_unlike_3d_fine,c2err_unlike_3d_fine,
+     2           max_h_3d,max_c2_3d,n_3d_fine,
+     3           num_pairs_unlike_inc,num_pairs_unlike_ref)
+            Call c2_3d(hinc_unlike_3d_coarse,href_unlike_3d_coarse,
+     1           c2fit_unlike_3d_coarse,c2err_unlike_3d_coarse,
+     2           max_h_3d,max_c2_3d,n_3d_coarse,
+     3           num_pairs_unlike_inc,num_pairs_unlike_ref)
+          end if
+        end if
+      end if     ! End 3D correlations
+
+      Return
+      END
+
+
+C-----------------------------------------------------------------------
+
+
+      subroutine c2_1d(h,href,c2,c2err,maxh,maxc2,n,num_pairs_sig,
+     1                 num_pairs_bkg)
+      implicit none
+
+CCC   Computes the two-body correlation function for 1D distributions.
+CCC   Errors are also computed.
+CCC
+CCC   Description of Input Variables in Argument List:
+C
+C     h(maxh)       = signal histogram (numerator)
+C     href(maxh)    = background histogram (denominator)
+C     c2(maxc2)     = correlation function = a/b
+C     c2err(maxc2)  = correlation function error
+C     maxh          = dimension of histogram arrays
+C     maxc2         = dimension of correlation function array.
+C     n             = # bins to use
+C     num_pairs_sig = # pairs used in signal histogram
+C     num_pairs_bkg = # pairs used in background histogram
+C
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 maxh,maxc2,n,num_pairs_sig,num_pairs_bkg
+      integer*4 h(maxh), href(maxh)
+      integer*4 k
+
+      real*4    c2(maxc2), c2err(maxc2)
+      real*4    a,a_error,b,b_error
+
+      do k = 1,n
+        if(href(k).le.0 .or. h(k).le.0) then
+          c2(k) = 0.0
+          c2err(k) = 1.0
+        else
+          a = float(h(k))/float(num_pairs_sig)
+          a_error = sqrt(float(h(k)))/float(num_pairs_sig)
+          b = float(href(k))/float(num_pairs_bkg)
+          b_error = sqrt(float(href(k)))/float(num_pairs_bkg)
+          c2(k) = a/b
+          c2err(k) = c2(k)*sqrt((a_error/a)**2 + (b_error/b)**2)
+        end if
+      end do
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+
+      subroutine c2_3d(h,href,c2,c2err,maxh,maxc2,n,num_pairs_sig,
+     1                 num_pairs_bkg)
+      implicit none
+
+CCC   Computes the two-body correlation function for 3D distributions.
+CCC   Errors are also computed.
+CCC
+CCC   Description of Input Variables in Argument List:
+C
+C     h(maxh,maxh,maxh)         = 3D signal histogram (numerator)
+C     href(maxh,maxh,maxh))     = 3D background histogram (denominator)
+C     c2(maxc2,maxc2,maxc2)     = 3D correlation function = a/b
+C     c2err(maxc2,maxc2,maxc2)  = 3D correlation function error
+C     maxh          = dimension of 3D histogram arrays
+C     maxc2         = dimension of 3D correlation function array.
+C     n             = # bins to use
+C     num_pairs_sig = # pairs used in signal histogram
+C     num_pairs_bkg = # pairs used in background histogram
+C
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 maxh,maxc2,n,num_pairs_sig,num_pairs_bkg
+      integer*4 h(maxh,maxh,maxh), href(maxh,maxh,maxh)
+      integer*4 i,j,k
+
+      real*4    c2(maxc2,maxc2,maxc2), c2err(maxc2,maxc2,maxc2)
+      real*4    a,a_error,b,b_error
+
+      do i = 1,n
+      do j = 1,n
+      do k = 1,n
+        if(href(i,j,k).le.0 .or. h(i,j,k).le.0) then
+          c2(i,j,k) = 0.0
+          c2err(i,j,k) = 1.0
+        else
+          a = float(h(i,j,k))/float(num_pairs_sig)
+          a_error = sqrt(float(h(i,j,k)))/float(num_pairs_sig)
+          b = float(href(i,j,k))/float(num_pairs_bkg)
+          b_error = sqrt(float(href(i,j,k)))/float(num_pairs_bkg)
+          c2(i,j,k) = a/b
+          c2err(i,j,k) = c2(i,j,k)*sqrt((a_error/a)**2 + (b_error/b)**2)
+        end if
+      end do
+      end do
+      end do
+
+      Return
+      END
+
+
+C-------------------------------------------------------------------------
+
+
+      subroutine chisquare(mode,chisq_like_1d,chisq_unlike_1d,
+     1           chisq_like_3d_fine,chisq_unlike_3d_fine,
+     2           chisq_like_3d_coarse,chisq_unlike_3d_coarse,
+     3           chisq_hist1_1,chisq_hist1_2)
+      implicit none
+
+CCC   This subroutine calculates the chi-squares for the following:
+C       o Like pair   1D 2-body correlations
+C       o Unlike pair 1D 2-body correlations
+C       o Like pair   3D, Fine Mesh   2-body correlations
+C       o Unlike pair 3D, Fine Mesh   2-body correlations
+C       o Like pair   3D, Coarse Mesh 2-body correlations
+C       o Unlike pair 3D, Coarse Mesh 2-body correlations
+C       o One-body 1D {pt,phi,eta} (summed) distributions for PID#1
+C       o One-body 1D {pt,phi,eta} (summed) distributions for PID#2
+C        
+C         (where the separate chi-squares for the 1D pt, phi and eta
+C          one-body distributions are added and only the sum is returned.)
+C
+C     'Mode' determines which one-body histogram is compared to the
+C     reference histogram, where:
+C
+C     If mode = 1, then hist1* are used
+C     If mode = 2, then htmp1* are used
+C
+C     The one-body reference histograms used in the chi-square calculation
+C     are in href1*
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 i,j,k,mode
+
+      real*4    chisq_like_1d, chisq_unlike_1d
+      real*4    chisq_like_3d_fine,chisq_unlike_3d_fine
+      real*4    chisq_like_3d_coarse,chisq_unlike_3d_coarse
+      real*4    chisq_hist1_1,chisq_hist1_2
+
+      real*4    n1fac,n2fac   ! # part 1(2) used/# part 1(2) used in Ref.
+      real*4    avgerrsq_pt_1, avgerrsq_phi_1, avgerrsq_eta_1
+      real*4    avgerrsq_pt_2, avgerrsq_phi_2, avgerrsq_eta_2
+      real*4    avgerrsq_pt_ref_1,avgerrsq_phi_ref_1,avgerrsq_eta_ref_1
+      real*4    avgerrsq_pt_ref_2,avgerrsq_phi_ref_2,avgerrsq_eta_ref_2
+      real*4    chisq1
+
+CCC   Initialize all chi-square values to zero:
+
+      chisq_like_1d          = 0.0
+      chisq_unlike_1d        = 0.0
+      chisq_like_3d_fine     = 0.0
+      chisq_unlike_3d_fine   = 0.0
+      chisq_like_3d_coarse   = 0.0
+      chisq_unlike_3d_coarse = 0.0
+      chisq_hist1_1          = 0.0
+      chisq_hist1_2          = 0.0
+
+      if(switch_1d .gt. 0) then
+        if(switch_type.eq.1 .or. switch_type.eq.3) then
+          do i = 1,n_1d_total
+            if(c2fit_like_1d(i) .ne. 0.0) then
+              chisq_like_1d = chisq_like_1d + ((c2fit_like_1d(i)
+     1          - c2mod_like_1d(i))/c2err_like_1d(i))**2
+            end if
+          end do
+        end if
+        if(switch_type.eq.2 .or. switch_type.eq.3) then
+          do i = 1,n_1d_total
+            if(c2fit_unlike_1d(i) .ne. 0.0) then
+              chisq_unlike_1d = chisq_unlike_1d + ((c2fit_unlike_1d(i)
+     1          - c2mod_unlike_1d(i))/c2err_unlike_1d(i))**2
+            end if
+          end do
+        end if
+      end if        ! End 1D correlation function, chi-square option
+
+      if(switch_3d .gt. 0) then
+        if(switch_type.eq.1 .or. switch_type.eq.3) then
+
+          if(n_3d_fine .gt. 0) then
+            do i = 1,n_3d_fine
+            do j = 1,n_3d_fine
+            do k = 1,n_3d_fine
+              if(c2fit_like_3d_fine(i,j,k).ne.0.0) then
+              chisq_like_3d_fine = chisq_like_3d_fine 
+     1          + ((c2fit_like_3d_fine(i,j,k)
+     2          -   c2mod_like_3d_fine(i,j,k))
+     3             /c2err_like_3d_fine(i,j,k))**2
+              end if
+            end do
+            end do
+            end do
+          end if
+
+          if(n_3d_coarse .gt. 0) then
+            do i = 1,n_3d_coarse
+            do j = 1,n_3d_coarse
+            do k = 1,n_3d_coarse
+              if((i+j+k).gt.3) then
+              if(c2fit_like_3d_coarse(i,j,k).ne.0.0) then
+              chisq_like_3d_coarse = chisq_like_3d_coarse 
+     1          +((c2fit_like_3d_coarse(i,j,k)
+     2          -  c2mod_like_3d_coarse(i,j,k))
+     3            /c2err_like_3d_coarse(i,j,k))**2
+              end if
+              end if
+            end do
+            end do
+            end do
+          end if
+
+        end if
+
+        if(switch_type.eq.2 .or. switch_type.eq.3) then
+
+          if(n_3d_fine .gt. 0) then
+            do i = 1,n_3d_fine
+            do j = 1,n_3d_fine
+            do k = 1,n_3d_fine
+              if(c2fit_unlike_3d_fine(i,j,k).ne.0.0) then
+              chisq_unlike_3d_fine = chisq_unlike_3d_fine 
+     1          + ((c2fit_unlike_3d_fine(i,j,k)
+     2          -   c2mod_unlike_3d_fine(i,j,k))
+     3             /c2err_unlike_3d_fine(i,j,k))**2
+              end if
+            end do
+            end do
+            end do
+          end if
+
+          if(n_3d_coarse .gt. 0) then
+            do i = 1,n_3d_coarse
+            do j = 1,n_3d_coarse
+            do k = 1,n_3d_coarse
+              if((i+j+k).gt.3) then
+              if(c2fit_unlike_3d_coarse(i,j,k).ne.0.0) then
+              chisq_unlike_3d_coarse = chisq_unlike_3d_coarse 
+     1          +((c2fit_unlike_3d_coarse(i,j,k)
+     2          -  c2mod_unlike_3d_coarse(i,j,k))
+     3            /c2err_unlike_3d_coarse(i,j,k))**2
+              end if
+              end if
+            end do
+            end do
+            end do
+          end if
+
+        end if
+      end if         !  End of 3D Correlation Function, Chi-Square Option
+
+CCC   Obtain chi-squares for one-body distributions
+
+      if(pid(1) .gt. 0) then
+        n1fac = float(n_part_used_1_trk)/float(n_part_used_1_ref)
+        avgerrsq_pt_1      = float(n_part_used_1_trk)/float(n_pt_bins)
+        avgerrsq_phi_1     = float(n_part_used_1_trk)/float(n_phi_bins)
+        avgerrsq_eta_1     = float(n_part_used_1_trk)/float(n_eta_bins)
+        avgerrsq_pt_ref_1  = float(n_part_used_1_ref)/float(n_pt_bins)
+        avgerrsq_phi_ref_1 = float(n_part_used_1_ref)/float(n_phi_bins)
+        avgerrsq_eta_ref_1 = float(n_part_used_1_ref)/float(n_eta_bins)
+      end if
+
+      if(pid(2) .gt. 0) then
+        n2fac = float(n_part_used_2_trk)/float(n_part_used_2_ref)
+        avgerrsq_pt_2      = float(n_part_used_2_trk)/float(n_pt_bins)
+        avgerrsq_phi_2     = float(n_part_used_2_trk)/float(n_phi_bins)
+        avgerrsq_eta_2     = float(n_part_used_2_trk)/float(n_eta_bins)
+        avgerrsq_pt_ref_2  = float(n_part_used_2_ref)/float(n_pt_bins)
+        avgerrsq_phi_ref_2 = float(n_part_used_2_ref)/float(n_phi_bins)
+        avgerrsq_eta_ref_2 = float(n_part_used_2_ref)/float(n_eta_bins)
+      end if
+
+      if(pid(1) .gt. 0) then
+        if(mode .eq. 1) then
+
+          chisq_hist1_1 = 
+     1      chisq1(hist1_pt_1,href1_pt_1,max_h_1d,avgerrsq_pt_1,
+     2             avgerrsq_pt_ref_1,n1fac,n_pt_bins)
+     3     +chisq1(hist1_phi_1,href1_phi_1,max_h_1d,avgerrsq_phi_1,
+     4             avgerrsq_phi_ref_1,n1fac,n_phi_bins)
+     5     +chisq1(hist1_eta_1,href1_eta_1,max_h_1d,avgerrsq_eta_1,
+     6             avgerrsq_eta_ref_1,n1fac,n_eta_bins)
+
+        else if(mode .eq. 2) then
+
+          chisq_hist1_1 =
+     1      chisq1(htmp1_pt_1,href1_pt_1,max_h_1d,avgerrsq_pt_1,
+     2             avgerrsq_pt_ref_1,n1fac,n_pt_bins)
+     3     +chisq1(htmp1_phi_1,href1_phi_1,max_h_1d,avgerrsq_phi_1,
+     4             avgerrsq_phi_ref_1,n1fac,n_phi_bins)
+     5     +chisq1(htmp1_eta_1,href1_eta_1,max_h_1d,avgerrsq_eta_1,
+     6             avgerrsq_eta_ref_1,n1fac,n_eta_bins)
+
+        end if
+      end if     ! End pid(1) one-body histogram chi-square calculation
+
+      if(pid(2) .gt. 0) then
+        if(mode .eq. 1) then
+
+          chisq_hist1_2 = 
+     1      chisq1(hist1_pt_2,href1_pt_2,max_h_1d,avgerrsq_pt_2,
+     2             avgerrsq_pt_ref_2,n2fac,n_pt_bins)
+     3     +chisq1(hist1_phi_2,href1_phi_2,max_h_1d,avgerrsq_phi_2,
+     4             avgerrsq_phi_ref_2,n2fac,n_phi_bins)
+     5     +chisq1(hist1_eta_2,href1_eta_2,max_h_1d,avgerrsq_eta_2,
+     6             avgerrsq_eta_ref_2,n2fac,n_eta_bins)
+
+        else if(mode .eq. 2) then
+
+          chisq_hist1_2 =
+     1      chisq1(htmp1_pt_2,href1_pt_2,max_h_1d,avgerrsq_pt_2,
+     2             avgerrsq_pt_ref_2,n2fac,n_pt_bins)
+     3     +chisq1(htmp1_phi_2,href1_phi_2,max_h_1d,avgerrsq_phi_2,
+     4             avgerrsq_phi_ref_2,n2fac,n_phi_bins)
+     5     +chisq1(htmp1_eta_2,href1_eta_2,max_h_1d,avgerrsq_eta_2,
+     6             avgerrsq_eta_ref_2,n2fac,n_eta_bins)
+
+        end if
+      end if     ! End pid(2) one-body histogram chi-square calculation
+
+      Return
+      END
+
+C----------------------------------------------------------------------
+
+
+      real*4 function chisq1(h,href,maxh,herravgsq,hreferravgsq,
+     1                       numfac,nbins)
+      implicit none
+
+CCC   Compute chi-square for 1D histogram h(), with respect to the
+CCC   reference histogram, href().
+C
+C     h(maxh)       = 1D histogram array
+C     href(maxh)    = 1D reference histogram array
+C     maxh          = dimension of histogram arrays
+C     herravgsq     = average error squared in histogram h's bins
+C     hreferravgsq  = average error squared in ref. hist. href's bins
+C     numfac        = ratio of total number of entries in h to that
+C                     in href
+C     nbins         = # bins to use in chi-square sum, starting at array
+C                     element 1,2,... nbins (where nbins .le. maxh)
+C
+C     The chi-square value is returned in chisq1
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 maxh, nbins, i
+      integer*4 h(maxh),href(maxh)
+
+      real*4 herravgsq,hreferravgsq,numfac,numfacsq
+      real*4 herrsq,hreferrsq
+
+      chisq1 = 0.0
+      numfacsq = numfac*numfac
+
+      do i = 1,nbins
+        if(h(i) .gt. 0) then
+          herrsq = float(h(i))
+        else
+          herrsq = herravgsq
+        end if
+
+        if(href(i) .gt. 0) then
+          hreferrsq = float(href(i))
+        else
+          hreferrsq = hreferravgsq
+        end if
+
+        chisq1 = chisq1 + ((float(h(i)) - numfac*float(href(i)))**2)
+     1           /(herrsq + numfacsq*hreferrsq)
+      end do
+
+      Return
+      END
+
+C-----------------------------------------------------------------------
+
+
+      Subroutine write_data(mode,ievent)
+      implicit none
+
+CCC   This subroutine writes the main output file, 'hbt_simulation.out'
+C     on File Unit 8.  File Unit 8 is opened and closed by the main
+C     program.
+C
+C     Also, the computed 1- and 2-body reference histograms are printed
+C     out from this subroutine on File Units 11 and 9, respectively.  These
+C     files are opened/closed here.
+C
+C     Output content determined by input parameter 'mode', where:
+C
+C     Mode           Description of Output
+C    -----   -----------------------------------------------------------
+C      1     basic output file header
+C            input and derived quantities
+C
+C      2     reference histograms (1 and 2-body)
+C            saved to separate I/O File Unit=11,9 respectively
+C
+C      3     reference histogram output
+C 
+C      4     correlation model
+C
+C      5     correlation fit and one-body distributions
+C            for each event, optional output 
+C
+C      6     inclusive one-body distributions and inclusive
+C            correlation fit; projection onto 1D axes.
+C 
+
+      Include 'common_parameters.inc'
+      Include 'common_mesh.inc'
+      Include 'common_histograms.inc'
+      Include 'common_correlations.inc'
+      Include 'common_coulomb.inc'
+      Include 'common_event_summary.inc'
+
+      Include 'common_track.inc'
+      Include 'common_sec_track.inc'
+      Include 'common_sec_track2.inc'
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 mode,i,j,k,ievent,ref_print,nev
+     
+      real*4 nfac1,nfac2,ref_error
+      real*4 c2mod_proj1(max_c2_3d)
+      real*4 c2mod_proj2(max_c2_3d)
+      real*4 c2mod_proj3(max_c2_3d)
+      real*4 c2fit_proj1(max_c2_3d)
+      real*4 c2fit_proj2(max_c2_3d)
+      real*4 c2fit_proj3(max_c2_3d)
+      real*4 c2err_proj1(max_c2_3d)
+      real*4 c2err_proj2(max_c2_3d)
+      real*4 c2err_proj3(max_c2_3d)
+
+C-------------------------------------------
+      If(mode.eq.1) Then   !Basic Output Header
+C-------------------------------------------
+
+      write(8,100)          
+      write(8,101)    
+      write(8,100)          
+C     write(8,102) n_events          
+      write(8,103) n_pid_types,pid(1),mass1,pid(2),mass2         
+      write(8,104) ref_control
+      write(8,105) switch_1d         
+      write(8,106) switch_3d         
+      write(8,107) switch_type         
+      write(8,108) switch_coherence         
+      write(8,109) switch_coulomb         
+      write(8,110) switch_fermi_bose         
+      write(8,1101) trk_accep
+      write(8,111) print_full,print_sector_data         
+C     write(8,112) n_part_used_1_ref,n_part_used_2_ref          
+C     write(8,113) n_part_used_1_inc,n_part_used_2_inc         
+C     write(8,114) num_pairs_like_ref,num_pairs_unlike_ref         
+C     write(8,115) num_pairs_like_inc,num_pairs_unlike_inc         
+      write(8,116) lambda         
+      write(8,117) R_1d          
+      write(8,118) Rside,Rout,Rlong         
+      write(8,119) Rperp,Rparallel,R0        
+      write(8,120) Q0         
+      write(8,121) irand          
+      write(8,122) maxit          
+      write(8,123) deltap         
+      write(8,124) delchi         
+      write(8,125) chisq_wt_like_1d         
+      write(8,126) chisq_wt_unlike_1d         
+      write(8,127) chisq_wt_like_3d_fine         
+      write(8,128) chisq_wt_unlike_3d_fine         
+      write(8,129) chisq_wt_like_3d_coarse         
+      write(8,130) chisq_wt_unlike_3d_coarse         
+      write(8,131) chisq_wt_hist1_1         
+      write(8,132) chisq_wt_hist1_2         
+      write(8,133)          
+      write(8,134) n_pt_bins,pt_bin_size,pt_min,pt_max         
+      write(8,135) n_phi_bins,phi_bin_size,phi_min,phi_max          
+      write(8,136) n_eta_bins,eta_bin_size,eta_min,eta_max          
+      write(8,137)          
+      write(8,138) n_px_bins,delpx,px_min,px_max         
+      write(8,139) n_py_bins,delpy,py_min,py_max          
+      write(8,140) n_pz_bins,delpz,pz_min,pz_max          
+      write(8,141) n_sectors         
+      write(8,142)          
+      write(8,143) n_1d_fine,n_1d_coarse,n_1d_total          
+      write(8,144) binsize_1d_fine,binsize_1d_coarse         
+      write(8,145) qmid_1d,qmax_1d         
+      write(8,146)          
+      write(8,147) n_3d_fine,n_3d_coarse,n_3d_total         
+      write(8,148) binsize_3d_fine,binsize_3d_coarse         
+      write(8,149) qmid_3d,qmax_3d
+      write(8,150) n_3d_fine_project
+
+CCC   Formats for Mode=1 Output         
+
+ 100  format(   15x,50('*'))      
+ 101  format(   15x,'*****',7x,'HBT CORRELATION SIMULATION',7x,'*****')
+ 102  format(///15x,'Number of Events in Event Text Input File=',I5)
+ 103  format(  /15x,'#PID types=',I2,'  PID#,mass=',I2,F8.5,
+     1'  PID#,mass=',I2,F8.5)
+ 104  format(/  15x,'Reference Spectra Selection Option=',I2)
+ 105  format(// 15x,'Control Switches: Switch_1d         =',I2)
+ 106  format(   15x,'                  Switch_3d         =',I2)
+ 107  format(   15x,'                  Switch_type       =',I2)
+ 108  format(   15x,'                  Switch_coherence  =',I2)
+ 109  format(   15x,'                  Switch_coulomb    =',I2)
+ 110  format(   15x,'                  Switch_fermi_bose =',I2)
+1101  format(   15x,'                  trk_accep         =',F10.7)
+ 111  format(/  15x,'Print Options: Full=',I2,'  Sectors=',I2)
+ 112  format(// 15x,
+     1'Number particles used in Reference, for PID types=',2I5)
+ 113  format( 15x,
+     1'Number particles used in Inclusive, for PID types=',2I5)
+ 114  format(/  15x,
+     1'Number pairs used in Reference, like and unlike=',2I5)
+ 115  format(  15x,
+     1'Number pairs used in Inclusive, like and unlike=',2I5)
+ 116  format(//  15x,'Correlation Model Parameters: Chaoticity =',F8.5)
+ 117  format(    15x,'1D Spherical Source Radius=',F8.4)
+ 118  format(    15x,'Bertsch-Pratt R-side,out,long=',3F8.4)
+ 119  format(    15x,'YKP R-perp,parallel,time=',3F8.4)
+ 120  format(    15x,'Coulomb parameter=',F8.5)
+ 121  format(//  15x,'Iteration Controls: Random # seed        =',I10)
+ 122  format(    15x,'                    Max # iterations     =',I5)
+ 123  format(    15x,'                    Momentum Shift Range =',F8.5)
+ 124  format(    15x,'                    Min % Chi-Sq limit   =',F8.5)
+ 125  format(//  15x,'CHI-Sq Weights: correl,like,  1d       =',F8.5)
+ 126  format(    15x,'                correl,unlike,1d       =',F8.5)
+ 127  format(    15x,'                correl,like,  3d_fine  =',F8.5)
+ 128  format(    15x,'                correl,unlike,3d_fine  =',F8.5)
+ 129  format(    15x,'                correl,like,  3d_coarse=',F8.5)
+ 130  format(    15x,'                correl,unlike,3d_coarse=',F8.5)
+ 131  format(    15x,'                1-body, PID#1          =',F8.5)
+ 132  format(    15x,'                1-body, PID#2          =',F8.5)
+ 133  format(//  15x,'Momentum Space Acceptance Range and 1D Bins:')
+ 134  format(    15x,'#bins,bin size,min,max for pt =',I5,3F8.5)
+ 135  format(    15x,'#bins,bin size,min,max for phi=',I5,3F8.4)
+ 136  format(    15x,'#bins,bin size,min,max for eta=',I5,3F8.4)
+ 137  format(//  15x,'Momentum Space Sectors:')
+ 138  format(    15x,'#sectors,sectorsize,min,max for px=',I5,3F8.4)
+ 139  format(    15x,'#sectors,sectorsize,min,max for py=',I5,3F8.4)
+ 140  format(    15x,'#sectors,sectorsize,min,max for pz=',I5,3F8.4)
+ 141  format(    15x,'Total Number of Sectors           =',I5)
+ 142  format(//  15x,'2-Body Correlations, 1-D Grid:')
+ 143  format(    15x,'#bins_fine,coarse,total     =',3I5)
+ 144  format(    15x,'bin size - fine, coarse     =',2F8.5)
+ 145  format(    15x,'Q mid point, Q maximum      =',2F8.5)
+ 146  format(//  15x,'2-Body Correlations, 3-D Grid:')
+ 147  format(    15x,'#bins - fine, coarse, total =',3I5)
+ 148  format(    15x,'bin size - fine, coarse     =',2F8.5)
+ 149  format(    15x,'Q mid point, Q maximum      =',2F8.5)
+ 150  format(    15x,'# 3D fine bin projected     =',I5)
+
+CCC   END mode=1 Output and Formats
+
+C-----------------------------
+      Else If(mode.eq.2) Then  !Store 2- and 1-body Ref. Histograms
+C-----------------------------
+
+
+      open(unit=9,status='unknown',access='sequential',
+     1     name='hbt_pair_reference.hist')
+      open(unit=11,status='unknown',access='sequential',
+     1     name='hbt_singles_reference.hist')
+
+C     Write Pair Reference Hist:
+
+      write(9,201) n_pid_types,pid(1),pid(2)
+      write(9,202) n_pt_bins,pt_min,pt_max
+      write(9,202) n_phi_bins,phi_min,phi_max
+      write(9,202) n_eta_bins,eta_min,eta_max
+      write(9,201) switch_1d,switch_3d,switch_type
+      write(9,203) n_1d_fine,n_1d_coarse,n_3d_fine,n_3d_coarse
+      write(9,204) binsize_1d_fine,binsize_1d_coarse,
+     1             binsize_3d_fine,binsize_3d_coarse
+      write(9,201) num_pairs_like_ref,num_pairs_unlike_ref
+ 201  format(2x,3I10)
+ 202  format(2x,I10,2E15.6)
+ 203  format(2x,4I10)
+ 204  format(2x,4E15.6)
+ 205  format(2x,I20)
+
+      if(switch_1d.gt.0.and.n_1d_total.gt.0) then
+       if(switch_type.eq.1.or.switch_type.eq.3) then
+          write(9,205) (href_like_1d(i),i=1,n_1d_total)
+        end if
+        if(switch_type.eq.2.or.switch_type.eq.3) then
+          write(9,205) (href_unlike_1d(i),i=1,n_1d_total)
+        endif
+      endif    !End 1D Ref. Hist. Output
+
+      if(switch_3d.gt.0) then
+       if(switch_type.eq.1.or.switch_type.eq.3) then
+
+         if(n_3d_fine.gt.0) then
+            do i=1,n_3d_fine
+            do j=1,n_3d_fine
+            do k=1,n_3d_fine
+               write(9,205) href_like_3d_fine(i,j,k)
+            enddo
+            enddo
+            enddo
+          endif
+
+          if(n_3d_coarse.gt.0) then
+            do i=1,n_3d_coarse
+            do j=1,n_3d_coarse
+            do k=1,n_3d_coarse
+               write(9,205) href_like_3d_coarse(i,j,k)
+            enddo
+            enddo
+            enddo
+          endif
+
+        end if
+
+        if(switch_type.eq.2.or.switch_type.eq.3) then
+
+          if(n_3d_fine.gt.0) then      
+            do i=1,n_3d_fine
+            do j=1,n_3d_fine
+            do k=1,n_3d_fine
+               write(9,205) href_unlike_3d_fine(i,j,k)
+            enddo
+            enddo
+            enddo
+          endif
+
+          if(n_3d_coarse.gt.0) then            
+            do i=1,n_3d_coarse
+            do j=1,n_3d_coarse
+            do k=1,n_3d_coarse
+               write(9,205) href_unlike_3d_coarse(i,j,k)
+            enddo
+            enddo
+            enddo
+          endif
+
+        endif
+      endif    !End 3D Reference Histograms Output
+
+CC    Write One-Body  - singles histograms:
+      
+      write(11,201) n_pid_types,pid(1),pid(2) 
+      write(11,202) n_pt_bins,pt_min,pt_max
+      write(11,202) n_phi_bins,phi_min,phi_max
+      write(11,202) n_eta_bins,eta_min,eta_max
+      write(11,201) n_part_used_1_ref,n_part_used_2_ref
+
+      if(pid(1).gt.0) then
+        write(11,205)(href1_pt_1(i),i=1,n_pt_bins)
+        write(11,205)(href1_phi_1(i),i=1,n_phi_bins)
+        write(11,205)(href1_eta_1(i),i=1,n_eta_bins)
+      endif
+  
+
+      if(pid(2).gt.0) then
+        write(11,205)(href1_pt_2(i),i=1,n_pt_bins)
+        write(11,205)(href1_phi_2(i),i=1,n_phi_bins)
+        write(11,205)(href1_eta_2(i),i=1,n_eta_bins)
+      endif
+      
+      close(unit=9)
+      close(unit=11)
+
+CCC   END mode=2 Reference Histogram Output
+
+C-----------------------------
+      Else If(mode.eq.3) Then  !Print out the Reference Histograms
+C-----------------------------
+
+      write(8,300)
+      write(8,301)
+      write(8,302) n_pt_bins,pt_min,pt_max
+      write(8,303) n_phi_bins,phi_min,phi_max
+      write(8,304) n_eta_bins,eta_min,eta_max
+      write(8,305) n_part_used_1_ref,n_part_used_2_ref
+
+      write(8,306)
+      do i=1,n_pt_bins
+         write(8,307) i,href1_pt_1(i),href1_pt_2(i)
+      enddo
+
+      write(8,308)
+      do i=1,n_phi_bins
+         write(8,307) i,href1_phi_1(i),href1_phi_2(i)
+      enddo
+
+      write(8,309)
+      do i=1,n_eta_bins
+         write(8,307) i,href1_eta_1(i),href1_eta_2(i)
+      enddo
+
+      write(8,310)
+      write(8,311) n_1d_fine,n_1d_coarse
+      write(8,312) binsize_1d_fine,binsize_1d_coarse
+      write(8,313) n_3d_fine,n_3d_coarse
+      write(8,314) binsize_3d_fine,binsize_3d_coarse
+      write(8,315) num_pairs_like_ref,num_pairs_unlike_ref
+
+      if(switch_1d.gt.0.and.n_1d_total.gt.0) then
+        write(8,316)
+            do i=1,n_1d_total
+               write(8,307) i,href_like_1d(i),href_unlike_1d(i)
+            enddo
+      endif    !End Print Out of 2-body, 1D reference histogram
+
+      if(switch_3d.gt.0.and.n_3d_fine.gt.0) then
+        write(8,317)
+        do i=1,n_3d_fine
+        do j=1,n_3d_fine
+        do k=1,n_3d_fine
+           write(8,318) i,j,k,href_like_3d_fine(i,j,k),
+     1                  href_unlike_3d_fine(i,j,k)
+        enddo
+        enddo
+        enddo
+      endif         !End Print Out of 2-Body, 3D-Fine Mesh Ref. Hist.
+
+
+      if(switch_3d.gt.0.and.n_3d_coarse.gt.0) then
+        write(8,319)
+        do i=1,n_3d_coarse
+        do j=1,n_3d_coarse
+        do k=1,n_3d_coarse
+           write(8,318) i,j,k,href_like_3d_coarse(i,j,k),
+     1                  href_unlike_3d_coarse(i,j,k)
+        enddo
+        enddo
+        enddo
+      endif        !End Print Out of 2-Body, 3D-Coarse Mesh Ref. Hist.
+
+CCC   Formats for mode=3 Output:
+
+ 300  format(///5x,15('*'),'REFERENCE HISTOGRAMS',15('*'))
+ 301  format(//15x,'ONE-BODY REFERENCE DISTRIBUTIONS:')
+ 302  format(/ 15x,'PT BINS: (#,min,max)=',I5,2F8.4)
+ 303  format(  15x,'PHI BINS:(#,min,max)=',I5,2F8.4)
+ 304  format(  15x,'ETA BINS:(#,min,max)=',I5,2F8.4)
+ 305  format(  15x,'Number particles used in Ref, PID type1,2=',2I8)
+ 306  format(/  9x,'PT',10x,'BIN#',5x,'PID-1',5x,'PID-2')
+ 308  format(/  9x,'PHI',9x,'BIN#',5x,'PID-1',5x,'PID-2')
+ 309  format(/  9x,'ETA',9x,'BIN#',5x,'PID-1',5x,'PID-2')
+ 307  format(  20x,I5,2I10)
+ 310  format(///15x,'TWO-BODY REFERENCE DISTRIBUTIONS:')
+ 311  format(/  15x,'#BINS FOR 1D-Fine and Coarse Grid =',2I5)
+ 312  format(   15x,'BIN SIZES FOR 1D-Fine and Coarse  =',2F8.5)
+ 313  format(   15x,'#BINS FOR 3D-Fine and Coarse Grid =',2I5)
+ 314  format(   15x,'BIN SIZES FOR 3D-Fine and Coarse  =',2F8.5)
+ 315  format(   15x,'Number of Like and Unlike Pairs For Ref. = ', 
+     1             2I10)
+ 316  format(/5x,'2-BODY, 1D',6x,'BIN#',5x,'LIKE',5x,'UNLIKE')
+ 317  format(/3x,'2-BODY, 3D-FINE',2x,'BIN:i',4x,'j',4x,
+     1     'k',5x,'LIKE',5x,'UNLIKE')
+ 318  format(   20x,3I5,2I10)
+ 319  format(/2x,'2-BODY, 3D-COARSE',1x,'BIN:i',4x,'j',4x,
+     1     'k',5x,'LIKE',5x,'UNLIKE')
+
+CCC   END mode=3  Output and Formats
+
+C----------------------------
+      Else If(mode.eq.4) Then  !Print Correlation Function Model
+C----------------------------
+
+      write(8,400)
+      write(8,311) n_1d_fine,n_1d_coarse
+      write(8,312) binsize_1d_fine,binsize_1d_coarse
+      write(8,313) n_3d_fine,n_3d_coarse
+      write(8,314) binsize_3d_fine,binsize_3d_coarse
+
+
+      if(switch_1d.gt.0.and.n_1d_total.gt.0) then
+        write(8,316)
+            do i=1,n_1d_total
+               write(8,407) i,c2mod_like_1d(i),c2mod_unlike_1d(i)
+            enddo
+      endif    !End Print Out of 2-body, 1D Model Correction Functions
+
+      if(switch_3d.gt.0.and.n_3d_fine.gt.0) then
+        write(8,317)
+        do i=1,n_3d_fine
+        do j=1,n_3d_fine
+        do k=1,n_3d_fine
+          write(8,418) i,j,k,c2mod_like_3d_fine(i,j,k),
+     1                 c2mod_unlike_3d_fine(i,j,k)
+        enddo
+        enddo
+        enddo
+      endif  !End Print Out of 2-Body, 3D-Fine mesh Model Correl. Function 
+
+      if(switch_3d.gt.0.and.n_3d_coarse.gt.0) then
+        write(8,319)
+        do i=1,n_3d_coarse
+        do j=1,n_3d_coarse
+        do k=1,n_3d_coarse
+          write(8,418) i,j,k,c2mod_like_3d_coarse(i,j,k),
+     1                 c2mod_unlike_3d_coarse(i,j,k)
+        enddo
+        enddo
+        enddo
+      endif  !End Print Out of 2-Body, 3D-Coarse Model Correlation Function
+
+      if(switch_coulomb.eq.3) then ! Print interpolated Pratt Model
+CC                                 ! Coulomb Correction for Finite
+CC                                 ! Source Radius Q0
+        write(8,401)Q0
+        write(8,402)
+        do i=1,max_c2_coul
+           write(8,403) i,q_coul(i),c2_coul_like(i),
+     1                  c2_coul_unlike(i)
+        enddo
+      endif        
+
+CCC   Additional Formats for Mode=4 Output:
+
+ 400  format(///5x,15('*'),'MODEL CORRELATION FUNCTIONS',15('*'))
+ 401  format(///15x,'COULOMB SOURCE RADIUS FOR PRATT MODEL=',F8.4)
+ 402  format(// 5x,'q-bin',2x,'q',4x,'C2_coul_like',2x,
+     1             'C2_coul_unlike')
+ 403  format(   5x,I5,3E15.6)
+ 407  format(  20x,I5,2F10.7)
+ 418  format(   20x,3I5,2F10.7)
+CCC   END MODE = 4  OUTPUT AND FORMATS
+
+C------------------------------
+      Else If(mode.eq.5) Then   ! Optional Output for 1- and 2-Body Fits
+C------------------------------ ! for each event.
+
+      write(8,500) ievent
+      write(8,501) n_part_1_trk,n_part_2_trk,n_part_tot_trk
+      write(8,502) n_part_used_1_trk, n_part_used_2_trk
+      write(8,503) num_pairs_like, num_pairs_unlike
+
+CCC   Output one-body distributions for event:
+
+      write(8,504)
+      if(pid(1) .gt. 0) then
+         nfac1 = float(n_part_used_1_trk)/float(n_part_used_1_ref)
+         write(8,505) nfac1
+
+         write(8,507)
+         do i = 1,n_pt_bins
+           ref_print = int(nfac1*float(href1_pt_1(i)))
+           ref_error = nfac1*sqrt(float(href1_pt_1(i)))
+           write(8,510) i,hist1_pt_1(i),ref_print,ref_error
+         end do
+
+         write(8,508)
+         do i = 1,n_phi_bins
+           ref_print = int(nfac1*float(href1_phi_1(i)))
+           ref_error = nfac1*sqrt(float(href1_phi_1(i)))
+           write(8,510) i,hist1_phi_1(i),ref_print,ref_error
+         end do
+
+         write(8,509)
+         do i = 1,n_eta_bins
+           ref_print = int(nfac1*float(href1_eta_1(i)))
+           ref_error = nfac1*sqrt(float(href1_eta_1(i)))
+           write(8,510) i,hist1_eta_1(i),ref_print,ref_error
+         end do
+
+      end if    !  End PID # 1, One-Body Distribution Output
+
+      if(pid(2) .gt. 0) then
+         nfac2 = float(n_part_used_2_trk)/float(n_part_used_2_ref)
+         write(8,506) nfac2
+
+         write(8,507)
+         do i = 1,n_pt_bins
+           ref_print = int(nfac2*float(href1_pt_2(i)))
+           ref_error = nfac2*sqrt(float(href1_pt_2(i)))
+           write(8,510) i,hist1_pt_2(i),ref_print,ref_error
+         end do
+
+         write(8,508)
+         do i = 1,n_phi_bins
+           ref_print = int(nfac2*float(href1_phi_2(i)))
+           ref_error = nfac2*sqrt(float(href1_phi_2(i)))
+           write(8,510) i,hist1_phi_2(i),ref_print,ref_error
+         end do
+
+         write(8,509)
+         do i = 1,n_eta_bins
+           ref_print = int(nfac2*float(href1_eta_2(i)))
+           ref_error = nfac2*sqrt(float(href1_eta_2(i)))
+           write(8,510) i,hist1_eta_2(i),ref_print,ref_error
+         end do
+
+      end if    !  End PID # 2, One-Body Distribution Output
+
+CCC   Output Two-Body Correlation Functions for Event:
+
+      write(8,520)
+      if(switch_1d.gt.0 .and. n_1d_total.gt.0) then
+         write(8,530)
+         write(8,521)
+         write(8,522)
+         do i = 1,n_1d_total
+            write(8,523) i,c2mod_like_1d(i),c2fit_like_1d(i),
+     1           c2err_like_1d(i),c2mod_unlike_1d(i),
+     2           c2fit_unlike_1d(i),c2err_unlike_1d(i)
+         end do
+      end if    !  End 1D Correlation Model and Fit Output 
+
+      if(switch_3d.gt.0 .and. n_3d_fine.gt.0) then
+         write(8,531)
+         write(8,524)
+         write(8,525)
+         do i = 1,n_3d_fine
+         do j = 1,n_3d_fine
+         do k = 1,n_3d_fine
+            write(8,526) i,j,k,c2mod_like_3d_fine(i,j,k),
+     1      c2fit_like_3d_fine(i,j,k),c2err_like_3d_fine(i,j,k),
+     2      c2mod_unlike_3d_fine(i,j,k),c2fit_unlike_3d_fine(i,j,k),
+     3      c2err_unlike_3d_fine(i,j,k)
+         end do
+         end do
+         end do
+      end if    !  End 3D Fine Mesh Correlation Model and Fit Output
+
+      if(switch_3d.gt.0 .and. n_3d_coarse.gt.0) then
+         write(8,532)
+         write(8,524)
+         write(8,525)
+         do i = 1,n_3d_coarse
+         do j = 1,n_3d_coarse
+         do k = 1,n_3d_coarse
+            write(8,526) i,j,k,c2mod_like_3d_coarse(i,j,k),
+     1      c2fit_like_3d_coarse(i,j,k),c2err_like_3d_coarse(i,j,k),
+     2      c2mod_unlike_3d_coarse(i,j,k),c2fit_unlike_3d_coarse(i,j,k),
+     3      c2err_unlike_3d_coarse(i,j,k)
+         end do
+         end do
+         end do
+      end if    !  End 3D Coarse Mesh Correlation Model and Fit Output
+
+CCC   Output Event Summary and Chi-Square Information for Event:
+
+      write(8,539) ievent
+      write(8,540) num_iter(ievent)
+      write(8,541) n_part_used_1_store(ievent),
+     1             n_part_used_2_store(ievent)
+      write(8,5411) n_part_tot_store(ievent)
+      write(8,542) num_sec_flagged_store(ievent)
+      write(8,543) frac_trks_out(ievent),frac_trks_flag(ievent)
+      write(8,544) chisq_like_1d_store(ievent),
+     1             chisq_unlike_1d_store(ievent)
+      write(8,545) chisq_like_3d_fine_store(ievent),
+     1             chisq_unlike_3d_fine_store(ievent)
+      write(8,546) chisq_like_3d_coarse_store(ievent),
+     1             chisq_unlike_3d_coarse_store(ievent)
+      write(8,547) chisq_hist1_1_store(ievent),
+     1             chisq_hist1_2_store(ievent)
+      write(8,548) chisq_total_store(ievent)
+
+CCC   Formats for Mode = 5 Output:
+
+500   Format(///5x,5('*'),'Fitted 1-Body Distributions and ',
+     1      'Correlations for Event #',I5,5('*'))
+501   Format(//15x,'Number of Particles of PID types 1,2,total = ',
+     1      3I5)
+502   Format(  15x,'Number of Particles of PID types 1,2 Used  = ',
+     1      2I5)
+503   Format(  15x,'Number of Pairs Used - Like and Unlike = ',2I10)
+504   Format(//5x,'Fitted and Normalized Reference One-Body ',
+     1      'Distributions')
+505   Format( /10x,'Particle Type 1: Reference Scale Factor = ',E12.5)
+506   Format( /10x,'Particle Type 2: Reference Scale Factor = ',E12.5)
+507   Format(/2x,' PT: BIN#',5x,'hist1',7x,'href1-scaled',2x,
+     1       'ref-err-scaled')
+508   Format(/2x,'PHI: BIN#',5x,'hist1',7x,'href1-scaled',2x,
+     1       'ref-err-scaled')
+509   Format(/2x,'ETA: BIN#',5x,'hist1',7x,'href1-scaled',2x,
+     1       'ref-err-scaled')
+510   Format(7x,I4,3x,I7,8x,I7,7x,F10.5)
+520   Format(//5x,'Model and Fitted Correlations')
+530   Format(//21x,'One-Dimensional Fit - Fine & Coarse Mesh')
+531   Format(//25x,'Three-Dimensional Fit - Fine Mesh')
+532   Format(//24x,'Three-Dimensional Fit - Coarse Mesh')
+521   Format(/1x,'BIN',13x,'LIKE PAIRS',27x,'UNLIKE PAIRS')
+522   Format(8x,'MOD',9x,'FIT',9x,'ERR',11x,'MOD',9x,'FIT',9x,
+     1       'ERR',/)
+523   Format(1x,I3,3E12.4,2x,3E12.4)
+524   Format(/2x,'BINS',12x,'LIKE PAIRS',24x,'UNLIKE PAIRS')
+525   Format(1x,' i j k',4x,'MOD',8x,'FIT',8x,'ERR',10x,'MOD',
+     1      8x,'FIT',8x,'ERR',/)
+526   Format(1x,3I2,3E11.4,2x,3E11.4)
+539   Format(///10x,'Event and Chi-Square Summary for Event #',I5)
+540   Format( //15x,'Number of Iterations             =',F10.2)
+541   Format(   15x,'# Particles Used for PID Types1,2=',2F10.2)
+5411  Format(   15x,'Total # Particles in track table =',F10.2)
+542   Format(   15x,'# Sectors Flagged                =',F10.2)
+543   Format(   15x,'Frac Trks Out of Accep., Flagged =',2E11.4)
+544   Format(   15x,'Chi-Sq: 1D - Like & Unlike       =',2E11.4)
+545   Format(   15x,'Chi-Sq: 3D - Fine -Like & Unlike =',2E11.4)
+546   Format(   15x,'Chi-Sq: 3D - Coarse-Like &Unlike =',2E11.4)
+547   Format(   15x,'Chi-Sq: One-Body Dist. PID# 1&2  =',2E11.4)
+548   Format(   15x,'Chi-Sq: Total Weighted           =',E11.4)
+
+CCC   End Mode = 5 Output and Formats
+      
+C------------------------------
+      Else If(mode.eq.6) Then  ! Inclusive 1 & 2 Body Output
+C------------------------------
+      write(8,600) n_events
+      write(8,601) n_part_used_1_inc,n_part_used_2_inc
+      write(8,602) num_pairs_like_inc,num_pairs_unlike_inc
+
+      write(8,603) 
+      if(pid(1).gt.0) then
+C    Division by zero check      
+        IF (n_part_used_1_ref .LE. 0) THEN
+         PRINT*,'************************************'
+         PRINT*,'*        HBT PROCESSOR             *'
+         PRINT*,'* Number of particles selected for *'
+         PRINT*,'*   processing is less or equal    *'
+         PRINT*,'* !!!!!!!!  ZER0  !!!!!!!!!!       *'
+         PRINT*,'* unable to proceed                *'
+         PRINT*,'* EXITING FORTRAN                  *'
+         PRINT*,'*                                  *'
+         PRINT*,'* HINT: broad the parameter regions*'
+         PRINT*,'* OR/AND number of particles OR/AND*'
+         PRINT*,'* number of events                 *'
+         PRINT*,'************************************'
+         WRITE(7,5481)
+5481     FORMAT(5x,'Number of particles selected for processing is',
+     1             ' less or equal 0',
+     2             ' - STOP')
+         errorcode = 1
+         Return   
+        END IF
+        nfac1=float(n_part_used_1_inc)/float(n_part_used_1_ref)
+        write(8,604) nfac1
+        write(8,605)
+        do i = 1,n_pt_bins
+          ref_print=int(nfac1*float(href1_pt_1(i)))
+          ref_error=nfac1*sqrt(float(href1_pt_1(i)))
+          write(8,510) i,hinc1_pt_1(i),ref_print,ref_error
+        enddo
+
+        write(8,606)
+        do i = 1,n_phi_bins
+          ref_print=int(nfac1*float(href1_phi_1(i)))
+          ref_error=nfac1*sqrt(float(href1_phi_1(i)))
+          write(8,510) i,hinc1_phi_1(i),ref_print,ref_error
+        enddo
+
+        write(8,607)
+        do i = 1,n_eta_bins
+          ref_print=int(nfac1*float(href1_eta_1(i)))
+          ref_error=nfac1*sqrt(float(href1_eta_1(i)))
+          write(8,510) i,hinc1_eta_1(i),ref_print,ref_error
+        enddo
+
+      endif    !END PID #1  One-BODY INCL. DISTRIBUTION OUTPUT
+
+      if(pid(2).gt.0) then
+        nfac2=float(n_part_used_2_inc)/float(n_part_used_2_ref)
+        write(8,608) nfac2
+        write(8,605)
+        do i = 1,n_pt_bins
+          ref_print=int(nfac2*float(href1_pt_2(i)))
+          ref_error=nfac2*sqrt(float(href1_pt_2(i)))
+          write(8,510) i,hinc1_pt_2(i),ref_print,ref_error
+        enddo
+
+        write(8,606)
+        do i = 1,n_phi_bins
+          ref_print=int(nfac2*float(href1_phi_2(i)))
+          ref_error=nfac2*sqrt(float(href1_phi_2(i)))
+          write(8,510) i,hinc1_phi_2(i),ref_print,ref_error
+        enddo
+
+        write(8,607)
+        do i = 1,n_eta_bins
+          ref_print=int(nfac2*float(href1_eta_2(i)))
+          ref_error=nfac2*sqrt(float(href1_eta_2(i)))
+          write(8,510) i,hinc1_eta_2(i),ref_print,ref_error
+        enddo
+
+      endif    !END PID #2  One-BODY INCl. DISTRIBUTION OUTPUT
+
+CC    OUTPUT TWO-BODY INCLUSIVE HISTOGRAMS:
+
+      write(8,660)
+      if(switch_1d.gt.0.and.n_1d_total.gt.0) then
+         write(8,316)
+         do i=1,n_1d_total
+            write(8,307) i,hinc_like_1d(i),hinc_unlike_1d(i)
+         end do
+      end if   ! End Print out of 2-Body, 1D Inclusive Histograms
+
+      if(switch_3d.gt.0.and.n_3d_fine.gt.0) then
+         write(8,317)
+         do i=1,n_3d_fine
+         do j=1,n_3d_fine
+         do k=1,n_3d_fine
+            write(8,318) i,j,k,hinc_like_3d_fine(i,j,k),
+     1                         hinc_unlike_3d_fine(i,j,k)
+        enddo
+        enddo
+        enddo
+      endif   ! End Print out of 2-Body, 3D-Fine Inclusive Histograms
+
+      if(switch_3d.gt.0.and.n_3d_coarse.gt.0) then
+         write(8,319)
+         do i=1,n_3d_coarse
+         do j=1,n_3d_coarse
+         do k=1,n_3d_coarse
+            write(8,318) i,j,k,hinc_like_3d_coarse(i,j,k),
+     1                         hinc_unlike_3d_coarse(i,j,k)
+        enddo
+        enddo
+        enddo
+      endif   ! End Print out of 2-Body, 3D-Coarse Inclusive Histograms
+
+CC    OUTPUT TWO-BODY INCL.CORRELATION FUNCTIONS FOR EVENT
+      
+      write(8,620)
+      if(switch_1d.gt.0.and.n_1d_total.gt.0) then
+        write(8,530)
+        write(8,521)
+        write(8,522)
+        do i=1,n_1d_total
+           write(8,523) i,c2mod_like_1d(i),c2fit_like_1d(i),
+     1                  c2err_like_1d(i),c2mod_unlike_1d(i),
+     2                  c2fit_unlike_1d(i),c2err_unlike_1d(i)
+        enddo
+      endif
+
+      if(switch_3d.gt.0.and.n_3d_fine.gt.0) then
+        write(8,531)
+        write(8,524)
+        write(8,525)
+        do i=1,n_3d_fine
+        do j=1,n_3d_fine
+        do k=1,n_3d_fine
+           write(8,526) i,j,k,c2mod_like_3d_fine(i,j,k),
+     1                       c2fit_like_3d_fine(i,j,k),
+     2                       c2err_like_3d_fine(i,j,k),
+     3                       c2mod_unlike_3d_fine(i,j,k),
+     4                       c2fit_unlike_3d_fine(i,j,k),
+     5                       c2err_unlike_3d_fine(i,j,k)
+
+        enddo
+        enddo
+        enddo
+      endif
+
+      if(switch_3d.gt.0.and.n_3d_coarse.gt.0) then
+        write(8,532)
+        write(8,524)
+        write(8,525)
+        do i=1,n_3d_coarse
+        do j=1,n_3d_coarse
+        do k=1,n_3d_coarse
+           write(8,526) i,j,k,c2mod_like_3d_coarse(i,j,k),
+     1                       c2fit_like_3d_coarse(i,j,k),
+     2                       c2err_like_3d_coarse(i,j,k),
+     3                       c2mod_unlike_3d_coarse(i,j,k),
+     4                       c2fit_unlike_3d_coarse(i,j,k),
+     5                       c2err_unlike_3d_coarse(i,j,k)
+
+        enddo
+        enddo
+        enddo
+      endif
+
+CCC   Compute and Print 1D projections of 3D fine mesh C2 model,
+CCC   fit and errors for like and unlike pairs.
+
+      if(switch_3d .gt. 0 .and. n_3d_fine .gt. 0) then
+         if(switch_type .eq. 1 .or. switch_type .eq. 3) then
+            Call c2_3d_projected(hinc_like_3d_fine,
+     1         href_like_3d_fine,c2mod_like_3d_fine,
+     2         c2mod_proj1,c2mod_proj2,c2mod_proj3,
+     3         c2fit_proj1,c2fit_proj2,c2fit_proj3,
+     4         c2err_proj1,c2err_proj2,c2err_proj3,
+     5         max_h_3d, max_c2_3d, n_3d_fine,
+     6         n_3d_fine_project,num_pairs_like_inc,
+     7         num_pairs_like_ref)
+            write(8,650)
+            write(8,651)
+            write(8,657)
+            do i = 1,n_3d_fine
+             write(8,658) i,c2mod_proj1(i),c2fit_proj1(i),c2err_proj1(i)
+            end do
+            write(8,652)
+            write(8,657)
+            do i = 1,n_3d_fine
+             write(8,658) i,c2mod_proj2(i),c2fit_proj2(i),c2err_proj2(i)
+            end do
+            write(8,653)
+            write(8,657)
+            do i = 1,n_3d_fine
+             write(8,658) i,c2mod_proj3(i),c2fit_proj3(i),c2err_proj3(i)
+            end do
+         end if       !  End Like pair output
+
+         if(switch_type .eq. 2 .or. switch_type .eq. 3) then
+            Call c2_3d_projected(hinc_unlike_3d_fine,
+     1         href_unlike_3d_fine,c2mod_unlike_3d_fine,
+     2         c2mod_proj1,c2mod_proj2,c2mod_proj3,
+     3         c2fit_proj1,c2fit_proj2,c2fit_proj3,
+     4         c2err_proj1,c2err_proj2,c2err_proj3,
+     5         max_h_3d, max_c2_3d, n_3d_fine,
+     6         n_3d_fine_project,num_pairs_unlike_inc,
+     7         num_pairs_unlike_ref)
+            write(8,654)
+            write(8,657)
+            do i = 1,n_3d_fine
+             write(8,658) i,c2mod_proj1(i),c2fit_proj1(i),c2err_proj1(i)
+            end do
+            write(8,655)
+            write(8,657)
+            do i = 1,n_3d_fine
+             write(8,658) i,c2mod_proj2(i),c2fit_proj2(i),c2err_proj2(i)
+            end do
+            write(8,656)
+            write(8,657)
+            do i = 1,n_3d_fine
+             write(8,658) i,c2mod_proj3(i),c2fit_proj3(i),c2err_proj3(i)
+            end do
+         end if       !  End Unlike pair output
+      end if          !  End 1D projections
+
+
+CCC   EVENT AND CHISQ SUMMARY INFORMATION:
+
+      if(n_events.le.max_events) then
+        nev=n_events
+      else
+        nev=max_events
+      endif
+      write(8,621)
+      write(8,622)
+
+      do i=1,nev
+        write(8,623) i,num_iter(i),n_part_used_1_store(i),
+     1               n_part_used_2_store(i),
+     2               num_sec_flagged_store(i),
+     3               frac_trks_out(i),frac_trks_flag(i),
+     4               chisq_total_store(i)
+      enddo
+
+      write(8,6231) trk_maxlen
+      write(8,6232)
+      do i=1,nev
+        write(8,6233) i,n_part_tot_store(i)
+      end do
+
+      write(8,624)
+      do i=1,nev
+        write(8,625) i,chisq_like_1d_store(i),
+     1               chisq_unlike_1d_store(i)
+      enddo
+
+
+      write(8,626)
+      do i=1,nev
+        write(8,625) i,chisq_like_3d_fine_store(i),
+     1               chisq_unlike_3d_fine_store(i)
+      enddo
+
+
+      write(8,627)
+      do i=1,nev
+        write(8,625) i,chisq_like_3d_coarse_store(i),
+     1               chisq_unlike_3d_coarse_store(i)
+      enddo
+
+
+      write(8,628)
+      do i=1,nev
+        write(8,625) i,chisq_hist1_1_store(i),
+     1                 chisq_hist1_2_store(i)
+      enddo
+
+CCC   Output the Mean and RMS values for the Event Loop:
+
+      write(8,629)
+      write(8,630)
+      write(8,631) niter_mean,niter_rms
+      write(8,632) npart1_mean,npart1_rms
+      write(8,633) npart2_mean,npart2_rms
+      write(8,6331) npart_tot_mean, npart_tot_rms
+      write(8,634) nsec_flag_mean,nsec_flag_rms
+      write(8,635) frac_trks_out_mean,frac_trks_out_rms
+      write(8,636) frac_trks_flag_mean,frac_trks_flag_rms
+      write(8,637) chi_l1d_mean,chi_l1d_rms
+      write(8,638) chi_u1d_mean,chi_u1d_rms
+      write(8,639) chi_l3f_mean,chi_l3f_rms
+      write(8,640) chi_u3f_mean,chi_u3f_rms
+      write(8,641) chi_l3c_mean,chi_l3c_rms
+      write(8,642) chi_u3c_mean,chi_u3c_rms
+      write(8,643) chi_1_1_mean,chi_1_1_rms
+      write(8,644) chi_1_2_mean,chi_1_2_rms
+      write(8,645) chi_tot_mean,chi_tot_rms
+
+CCC   FORMATS FOR MODE = 6 OUTPUT
+
+ 600  format(/// 2x,'FITTED 1-BODY DIST. AND CORRELATIONS ',
+     1      'FOR INCLUSIVE SUM OF',I5,' EVENTS')
+ 601  format(// 15x,'Inclusive # Particles USED of PID ', 
+     1      'types 1,2=',2I8)
+ 602  format(   15x,'Inclusive # of pairs used; like/unlike=',
+     1       2I10)
+ 603  format(//  5x,'Inclusive and Normalized Reference ',
+     1       'One-Body Distributions')
+ 604  format(/  10x,'Inclusive: Particle Type 1 - Reference ',
+     1       'Scale Factor=',E12.5)
+ 605  format(/   2x,' PT: BIN#',5x,'hinc1',7x,'href1-scaled',2x,
+     1      'ref-err-scaled')
+ 606  format(/   2x,'PHI: BIN#',5x,'hinc1',7x,'href1-scaled',2x,
+     1      'ref-err-scaled')
+ 607  format(/   2x,'ETA: BIN#',5x,'hinc1',7x,'href1-scaled',2x,
+     1      'ref-err-scaled')
+ 608  format(/  10x,'Inclusive: Particle Type 2 - ',
+     1      'Reference Scale Factor=',E12.5)
+ 620  format(//  5x,'MODEL AND INCLUSIVE FITTED CORRELATIONS')
+ 621  format(// 15x,'Event and Chi-Square Summary Lists')
+ 622  format(/   3x,'event',2x,'#iter',3x,'#PID1',4x,'#PID2',3x,
+     1      '#sec-flg',3x,'frac-out',4x,'frac-flg',3x,'CHISQ-TOT')
+ 623  format(3x,I5,2x,F6.0,2(1x,F8.0),1x,F9.0,
+     1           2(1x,F11.8),1x,E11.4)
+6231  format(/5x,'Max# tracks allowed in track table = ',I8)
+6232  format(/5x,'event',4x,'Tot# trks')
+6233  format(5x,I5,F12.2)
+ 624  format(/5x,'event',4x,'CHI_l1d',8x,'CHI_u1d')
+ 626  format(/5x,'event',4x,'CHI_l3f',8x,'CHI_u3f')
+ 627  format(/5x,'event',4x,'CHI_l3c',8x,'CHI_u3c')
+ 628  format(/5x,'event',4x,'CHI_1-1',8x,'CHI_1-2')
+ 625  format(5x,I5,2E15.6)
+ 629  format(// 10x,'Event and Chi-Square Summary - ',
+     1     'Mean and RMS Values')
+ 630  format(/  14x,'Quantity',15x,'Mean',11x,'RMS')
+ 631  format(    5x,'Number of Iterations      ',2E15.6)
+ 632  format(    5x,'#PID Type 1               ',2E15.6)
+ 633  format(    5x,'#PID Type 2               ',2E15.6)
+6331  format(    5x,'Tot # Tracks in Table     ',2E15.6)
+ 634  format(    5x,'#Sectors Flagged          ',2E15.6)
+ 635  format(    5x,'Frac. Trks Out of Accept. ',2E15.6)
+ 636  format(    5x,'Frac. Trks Flagged        ',2E15.6)
+ 637  format(    5x,'CHISQ like 1D             ',2E15.6)
+ 638  format(    5x,'CHISQ unlike 1D           ',2E15.6)
+ 639  format(    5x,'CHISQ like 3D Fine        ',2E15.6)
+ 640  format(    5x,'CHISQ unlike 3D Fine      ',2E15.6)
+ 641  format(    5x,'CHISQ like 3D Coarse      ',2E15.6)
+ 642  format(    5x,'CHISQ unlike 3D Coarse    ',2E15.6)
+ 643  format(    5x,'CHISQ 1 Body #1           ',2E15.6)
+ 644  format(    5x,'CHISQ 1 Body #2           ',2E15.6)
+ 645  format(    5x,'CHISQ Total               ',2E15.6)
+ 650  format(//10x ,'Inclusive Three-Dimensional Projected Fits -',
+     1       ' Fine Mesh')
+ 651  format( /25x ,'Like Pairs - Axis #1 ')
+ 652  format( /25x ,'Like Pairs - Axis #2 ')
+ 653  format( /25x ,'Like Pairs - Axis #3 ')
+ 654  format( /25x ,'Unlike Pairs - Axis #1 ')
+ 655  format( /25x ,'Unlike Pairs - Axis #2 ')
+ 656  format( /25x ,'Unlike Pairs - Axis #3 ')
+ 657  format(    2x,'BIN#',3x,'Model',8x,'Fit',8x,'Error')
+ 658  format(    3x,I3,3E12.4)
+ 660  format(//  5x,'INCLUSIVE TWO-BODY HISTOGRAMS')
+
+CCC   END MODE = 6 OUTPUT AND FORMATS
+
+C----------------
+      END IF
+C----------------
+
+      Return
+      END 
+
+C-----------------------------------------------------------------------
+
+
+      subroutine c2_3d_projected(h,href,c2mod,
+     1           c2mod_proj1,c2mod_proj2,c2mod_proj3,
+     2           c2fit_proj1,c2fit_proj2,c2fit_proj3,
+     3           c2err_proj1,c2err_proj2,c2err_proj3,
+     4           maxh,maxc2,n,n_proj,num_pairs_sig,
+     5           num_pairs_bkg)
+
+      implicit none
+
+CCC   This Subroutine computes the projected two-body correlation
+CCC   function for 3D distributions - fine mesh only; for both the
+CCC   correlation model (weighted with the reference histogram) and
+CCC   the inclusive correlation fit.
+CCC
+CCC   Description of Input Variables in the Argument List:
+CCC
+CCC      h(maxh,maxh,maxh)         = 3D fine mesh inclusive signal histog.
+CCC      href(maxh,maxh,maxh)      = 3D fine mesh inclusive background hist.
+CCC      c2mod(maxc2,maxc2,maxc2)  = 3D fine mesh correlation model
+CCC      maxh       = Dimension of 3D fine mesh histogram arrays
+CCC      maxc2      = Dimension of 3D fine mesh correlation function arrays
+CCC      n          = Number of bins to use
+CCC      n_proj     = Number of bins to integrate in (i,j) to project onto (k)
+CCC      num_pairs_sig = # pairs used in signal histogram
+CCC      num_pairs_bkg = # pairs used in background histogram
+CCC
+CCC   Description of Output quantities:
+CCC
+CCC      c2mod_proj1,2,3(maxc2) = Reference histogram weighted 1D projections
+CCC                               of C2 model function along {1,2,3} axes.
+CCC      c2fit_proj1,2,3(maxc2) = Fitted 3D correlation function projected
+CCC                               onto {1,2,3} axes.
+CCC      c2err_proj1,2,3(maxc2) = Error in fitted 3D correlation function 
+CCC                               projected onto {1,2,3} axes.
+
+CCC   Local Variable Type Declarations:
+
+      integer*4 maxh,maxc2,n,n_proj,num_pairs_sig,num_pairs_bkg
+      integer*4 h(maxh,maxh,maxh),href(maxh,maxh,maxh)
+      integer*4 i,j,k
+
+      real*4 c2mod(maxc2,maxc2,maxc2)
+      real*4 c2mod_proj1(maxc2),c2mod_proj2(maxc2),c2mod_proj3(maxc2)
+      real*4 c2fit_proj1(maxc2),c2fit_proj2(maxc2),c2fit_proj3(maxc2)
+      real*4 c2err_proj1(maxc2),c2err_proj2(maxc2),c2err_proj3(maxc2)
+      real*4 a,a_error,b,b_error
+      real*4 sum1n,sum1d,sum2n,sum2d,sum3n,sum3d
+
+CCC   Initialize arrays to zero:
+
+      do i = 1,maxc2
+         c2mod_proj1(i) = 0.0
+         c2mod_proj2(i) = 0.0
+         c2mod_proj3(i) = 0.0
+         c2fit_proj1(i) = 0.0
+         c2fit_proj2(i) = 0.0
+         c2fit_proj3(i) = 0.0
+         c2err_proj1(i) = 0.0
+         c2err_proj2(i) = 0.0
+         c2err_proj3(i) = 0.0
+      end do
+
+CCC   Project Reference spectra (histogram) weighted model correlation:
+
+      do i = 1,n
+         sum1n = 0.0
+         sum1d = 0.0
+         sum2n = 0.0
+         sum2d = 0.0
+         sum3n = 0.0
+         sum3d = 0.0
+         do j = 1,n_proj
+         do k = 1,n_proj
+            sum1n = sum1n + c2mod(i,j,k)*float(href(i,j,k))
+            sum1d = sum1d +              float(href(i,j,k))
+            sum2n = sum2n + c2mod(k,i,j)*float(href(k,i,j))
+            sum2d = sum2d +              float(href(k,i,j))
+            sum3n = sum3n + c2mod(j,k,i)*float(href(j,k,i))
+            sum3d = sum3d +              float(href(j,k,i))
+         end do
+         end do
+         if(sum1d .le. 0.0) then
+            c2mod_proj1(i) = 0.0
+         else
+            c2mod_proj1(i) = sum1n/sum1d
+         end if
+         if(sum2d .le. 0.0) then
+            c2mod_proj2(i) = 0.0
+         else
+            c2mod_proj2(i) = sum2n/sum2d
+         end if
+         if(sum3d .le. 0.0) then
+            c2mod_proj3(i) = 0.0
+         else
+            c2mod_proj3(i) = sum3n/sum3d
+         end if
+      end do
+
+CCC   Calculate and Project the fitted correlation functions:
+
+      do i = 1,n
+         sum1n = 0.0
+         sum1d = 0.0
+         sum2n = 0.0
+         sum2d = 0.0
+         sum3n = 0.0
+         sum3d = 0.0
+         do j = 1,n_proj
+         do k = 1,n_proj
+            sum1n = sum1n + float(h(i,j,k))
+            sum1d = sum1d + float(href(i,j,k))
+            sum2n = sum2n + float(h(k,i,j))
+            sum2d = sum2d + float(href(k,i,j))
+            sum3n = sum3n + float(h(j,k,i))
+            sum3d = sum3d + float(href(j,k,i))
+         end do
+         end do
+         if(sum1n .le. 0.0 .or. sum1d .le. 0.0) then
+            c2fit_proj1(i) = 0.0
+            c2err_proj1(i) = 1.0
+         else
+            a = sum1n/float(num_pairs_sig)
+            a_error = sqrt(sum1n)/float(num_pairs_sig)
+            b = sum1d/float(num_pairs_bkg)
+            b_error = sqrt(sum1d)/float(num_pairs_bkg)
+            c2fit_proj1(i) = a/b
+            c2err_proj1(i) = c2fit_proj1(i)*sqrt((a_error/a)**2
+     1                       + (b_error/b)**2)
+         end if
+         if(sum2n .le. 0.0 .or. sum2d .le. 0.0) then
+            c2fit_proj2(i) = 0.0
+            c2err_proj2(i) = 1.0
+         else
+            a = sum2n/float(num_pairs_sig)
+            a_error = sqrt(sum2n)/float(num_pairs_sig)
+            b = sum2d/float(num_pairs_bkg)
+            b_error = sqrt(sum2d)/float(num_pairs_bkg)
+            c2fit_proj2(i) = a/b
+            c2err_proj2(i) = c2fit_proj2(i)*sqrt((a_error/a)**2
+     1                       + (b_error/b)**2)
+         end if
+         if(sum3n .le. 0.0 .or. sum3d .le. 0.0) then
+            c2fit_proj3(i) = 0.0
+            c2err_proj3(i) = 1.0
+         else
+            a = sum3n/float(num_pairs_sig)
+            a_error = sqrt(sum3n)/float(num_pairs_sig)
+            b = sum3d/float(num_pairs_bkg)
+            b_error = sqrt(sum3d)/float(num_pairs_bkg)
+            c2fit_proj3(i) = a/b
+            c2err_proj3(i) = c2fit_proj3(i)*sqrt((a_error/a)**2
+     1                       + (b_error/b)**2)
+         end if
+      end do
+
+      Return
+      END
+
+C----------------------------------------------------------------------
+
+C>>>>>>>>>>>>>>   Piotr, this needs to be replaced with Ali random
+C>>>>>>>>>>>>>>>   number generator
+
+*      real*4 function hbtpran(i)
+*      implicit none
+*      integer i
+*      real*4 r
+*      Call ranhbtp(r,1,i)
+*      hbtpran = r
+*      Return
+*      END
+
+*      Include 'ranlux2.f'
+C----------------------------------------------------------------------
+
+
+
+
diff --git a/HBTP/hbt_particle_st.inc b/HBTP/hbt_particle_st.inc
new file mode 100644 (file)
index 0000000..705475d
--- /dev/null
@@ -0,0 +1,13 @@
+CCC   Geant Particle Properties:
+
+      Integer*4 part_maxlen
+      Parameter (part_maxlen = 50)
+
+      STRUCTURE /particle/
+         Integer*4   id          ! Geant particle ID code number; required
+CCC                              ! to be equal to the row number
+         Integer*4   charge      ! Electric charge in units of |e|
+         Real*4      mass        ! Rest mass in GeV/c**2
+         Real*4      lifetime    ! Proper lifetime in sec. 
+      END STRUCTURE
+
diff --git a/HBTP/hbt_sec_track2_st.inc b/HBTP/hbt_sec_track2_st.inc
new file mode 100644 (file)
index 0000000..0251ba7
--- /dev/null
@@ -0,0 +1,21 @@
+CCC   Second Track-to-Sector Mapping data structure:
+CCC   (Used for building the reference spectrum from the
+CCC    input event text file.)
+
+      Integer*4 max_trk_sec2
+      Integer*4 sec_maxlen2
+      Parameter (max_trk_sec2 = 30)
+      Parameter (sec_maxlen2  = 28000)
+
+      STRUCTURE /sec_trk_map2/
+         Integer*4 sec_id         !  unique sector ID number
+         Integer*4 n_trk_sec      !  Number of tracks assigned to sector
+         Integer*4 flag           !  normally=0, if = 1 then more than
+CCC                               !  max_trk_sec tracks could have been 
+CCC                               !  assigned to this sector, however the
+CCC                               !  maximum number that can be assigned is
+CCC                               !  max_trk_sec2.
+         Integer*4 track_id(max_trk_sec2)
+CCC                               !  Foreign keys to tracks in /track2/ that
+CCC                               !  are assigned to this sector.
+      END STRUCTURE
diff --git a/HBTP/hbt_sec_track_st.inc b/HBTP/hbt_sec_track_st.inc
new file mode 100644 (file)
index 0000000..1a7b887
--- /dev/null
@@ -0,0 +1,19 @@
+CCC   Track-to-Sector Mapping data structure:
+
+      Integer*4 max_trk_sec
+      Integer*4 sec_maxlen
+      Parameter (max_trk_sec = 30)
+      Parameter (sec_maxlen  = 28000)
+
+      STRUCTURE /sec_trk_map/
+         Integer*4 sec_id         !  unique sector ID number
+         Integer*4 n_trk_sec      !  Number of tracks assigned to sector
+         Integer*4 flag           !  normally=0, if = 1 then more than
+CCC                               !  max_trk_sec tracks could have been 
+CCC                               !  assigned to this sector, however the
+CCC                               !  maximum number that can be assigned is
+CCC                               !  max_trk_sec.
+         Integer*4 track_id(max_trk_sec)
+CCC                               !  Foreign keys to tracks in /track/ that
+CCC                               !  are assigned to this sector.
+      END STRUCTURE
diff --git a/HBTP/hbt_track2_st.inc b/HBTP/hbt_track2_st.inc
new file mode 100644 (file)
index 0000000..bbbae1e
--- /dev/null
@@ -0,0 +1,33 @@
+CCC   Second Track Data Structure:
+CCC   (This one is needed to build the reference spectrum from
+CCC    the event text input file.)
+
+      Integer*4 trk2_maxlen
+      Parameter (trk2_maxlen = 6500)
+
+      STRUCTURE /track2/
+         Integer*4   id          ! Track ID number
+         Integer*4   px_sec      ! px sector number
+         Integer*4   py_sec      ! py sector number
+         Integer*4   pz_sec      ! pz sector number
+         Integer*4   sector      ! unique sector ID number
+         Integer*4   flag        ! normally=0,if 1 indicates track assigned
+CCC                              ! to sector with too many tracks, if = 1
+CCC                              ! then track is not used.  See /sec_trk_map/ 
+         Integer*4   out_flag    ! flag indicating track in/out of accept.
+CCC                              ! non-zero for track pushed out of accept.
+         Integer*4   merge_flag  ! flag indicating track is merged (not used)
+         Integer*4   ge_pid      ! Geant particle ID code number
+         Integer*4  start_vertex ! From input event file - track's start vrtx
+         Integer*4  stop_vertex  ! From input event file - track's stop vrtx
+         Integer*4   event_line  ! Line # of track in input event text file
+         
+         Real*4      px          ! x component of track momentum in GeV/c
+         Real*4      py          ! y component of track momentum in GeV/c
+         Real*4      pz          ! z component of track momentum in GeV/c
+         Real*4      E           ! Total energy of track in GeV
+         Real*4      pt          ! pt of track momentum in GeV/c
+         Real*4      phi         ! azimuthal angle of track in degrees 
+         Real*4      eta         ! pseudorapidity of track
+      END STRUCTURE
+
diff --git a/HBTP/hbt_track_st.inc b/HBTP/hbt_track_st.inc
new file mode 100644 (file)
index 0000000..c261d4a
--- /dev/null
@@ -0,0 +1,31 @@
+CCC   Track Data Structure:
+
+      Integer*4 trk_maxlen
+      Parameter (trk_maxlen = 6500)
+
+      STRUCTURE /track/
+         Integer*4   id          ! Track ID number
+         Integer*4   px_sec      ! px sector number
+         Integer*4   py_sec      ! py sector number
+         Integer*4   pz_sec      ! pz sector number
+         Integer*4   sector      ! unique sector ID number
+         Integer*4   flag        ! normally=0,if 1 indicates track assigned
+CCC                              ! to sector with too many tracks, if = 1
+CCC                              ! then track is not used.  See /sec_trk_map/ 
+         Integer*4   out_flag    ! flag indicating track in/out of accept.
+CCC                              ! non-zero for track pushed out of accept.
+         Integer*4   merge_flag  ! flag indicating track is merged (not used)
+         Integer*4   ge_pid      ! Geant particle ID code number
+         Integer*4  start_vertex ! From input event file - track's start vrtx
+         Integer*4  stop_vertex  ! From input event file - track's stop vrtx
+         Integer*4   event_line  ! Line # of track in input event text file
+         
+         Real*4      px          ! x component of track momentum in GeV/c
+         Real*4      py          ! y component of track momentum in GeV/c
+         Real*4      pz          ! z component of track momentum in GeV/c
+         Real*4      E           ! Total energy of track in GeV
+         Real*4      pt          ! pt of track momentum in GeV/c
+         Real*4      phi         ! azimuthal angle of track in degrees 
+         Real*4      eta         ! pseudorapidity of track
+      END STRUCTURE
+
diff --git a/HBTP/ranlux.f b/HBTP/ranlux.f
new file mode 100644 (file)
index 0000000..030639a
--- /dev/null
@@ -0,0 +1,309 @@
+C*
+C* $Id$
+C*
+C* $Log$
+C* Revision 1.2  1997/09/22 13:45:47  mclareni
+C* Correct error in initializing RANLUX by using RLUXI