--- /dev/null
+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----------------------------------------------------------------------
+
+
+
+
git://git.uio.no / u / mrichter / AliRoot.git / commitdiff