MUON/reco_muon.F

   1 *  25/5/99
   2 **  Authors J.P. Cussonneau & P. Lautridou
   3
   4 ************** commentaires **********************
   5
   6 * bon muon = tous les hits de la trace (pas forcement 28) proviennent de muons
   7 * ghost = bonne trace dans laquelle certains hits proviennent délectrons, de muons ou sont ambigus
   8
   9 * ALPHATOP
  10 * alpha to P
  11
  12 * EFF
  13 * efficacite
  14
  15 * HHIT
  16 * h au vertex
  17
  18 * HTOP
  19 * h to P
  20
  21 * INDEXMAX
  22 * nombre de candidats a ordonner (a partir de l'ímpulsion)
  23
  24 * INDEXTAB
  25 * pour recuperer les candidats
  26
  27 * ISTAT
  28 * =1 si bon muon, =2 si ghost, =0 autrement
  29
  30 * ITCHECK
  31 * =1 si bonne trace, =0 autrement
  32
  33 * IT_LIST
  34 * permet a partir du numero de la trace de retrouver la numero du hit
  35
  36 * IT_NP
  37 * compte le nombre de plans touches par trace
  38
  39 * ITRACK
  40 * permet de retrouver le numero de la trace a partir du numero de hit
  41
  42 * ITTROUGH
  43 * pour une trace et une station donnee, dit si la trace est passee dans la chambre
  44
  45 * IVERTEX
  46 * =0 si point (0,0) du vertex impose, sinon coordonnes libres (pour le fit)
  47
  48 * JCAN
  49 * numero du hit pour une station et un candidat
  50
  51 * JCANTYP
  52 * nombre de hits par trace au niveau des stations 4 et 5 (3 ou 4)
  53
  54 * JJOUT
  55 * numero de hit associe a une chambre et a une trace
  56
  57 * NMUONALL
  58 * nombre de bons muons trouves
  59
  60 * NERR
  61 * = nombre de fois ou lón ná pas trouve la bonne trace dans la station
  62
  63 * NERRALL
  64 * nombre de cas ou pas de hit trouve par station
  65
  66 * NGHOSTALL
  67 * nombre de fantomes trouves
  68
  69 * NRES
  70 * nombre de resonances dans lácceptance
  71
  72 * NRESF
  73 * nombre de resonances trouvees
  74
  75 * NTRACFALL
  76 * nombre de traces totales trouvees
  77
  78 * NTRMUALL
  79 * nombre total de muons dans lácceptance
  80
  81
  82 ****************************************************************
  83       SUBROUTINE reconstmuon(IFIT,IDEBUGC,NEV,IDRES,IREADGEANT)
  84 ****************************************************************
  85       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
  86
  87       COMMON/DEBEVT/IDEBUG
  88       common/dstation/idstation
  89
  90 *      idsation = 8
  91       idstation = 20
  92
  93       IDEBUG=IDEBUGC
  94
  95 ** Read events
  96       CALL RECO_READEVT(NEV,IDRES,IREADGEANT)
  97
  98
  99 ** Trackfinding
 100       CALL RECO_TRACKF(IDRES,IREADGEANT)
 101
 102 ** Precision fit
 103       IF (IFIT.EQ.1) THEN
 104          CALL RECO_PRECISION
 105       ENDIF
 106
 107 ** Calculate
 108       CALL RECO_SUM
 109
 110       END
 111
 112 ********************************************
 113       BLOCK DATA
 114 ********************************************
 115       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 116       PARAMETER(NBSTATION=5)
 117 * --
 118       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
 119
 120 * ZPLANE = position de la premiere chambre de chaque station
 121 * exemple (pour la premiere station) :
 122 *           zch (dans AliMUONv0) = 540 (position du centre des 2 chambres)
 123 *           implique :
 124 *           ZPLANE = -530 si DZ_PL = 20cm
 125
 126 *     dstation = 8cm :
 127 *         DATA DZ_PL/8.,8.,8.,8.,8./
 128 *         DATA ZPLANE/-511.,-686.0,-971.,-1245.,-1445./
 129
 130 *     dstation=20cm :
 131          DATA DZ_PL/20.,20.,20.,20.,20./
 132          DATA ZPLANE/-518.,-680.,-965.,-1239.,-1439./
 133 *      end if
 134
 135 *      DATA ZCOIL,ZMAGEND/-825.0,-1125./  ! Constant field 3 Tm
 136       DATA ZCOIL,ZMAGEND/-805.0,-1233./ ! CCC magn. field map M.B
 137 **      DATA ZCOIL,ZMAGEND/-795.1,-1242.9/ ! CCC magn. field map M.B
 138
 139 * --
 140       END
 141
 142 ********************************************
 143       SUBROUTINE cutpxz(spxzcut)
 144 ********************************************
 145       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 146
 147       COMMON/ACUTPXZ/ACUTPXZ
 148
 149       ACUTPXZ = SPXZCUT
 150
 151       END
 152
 153 ********************************************
 154       SUBROUTINE sigmacut(ssigcut)
 155 ********************************************
 156       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 157
 158       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
 159      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
 160
 161       SIGCUT = SSIGCUT
 162
 163       END
 164
 165 ********************************************
 166       SUBROUTINE xpreci(sxprec)
 167 ********************************************
 168       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 169
 170       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
 171      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
 172
 173       XPREC = SXPREC
 174
 175       END
 176
 177 ********************************************
 178       SUBROUTINE ypreci(syprec)
 179 ********************************************
 180       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 181
 182       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
 183      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
 184
 185       YPREC = SYPREC
 186
 187       END
 188
 189 *************************************************************************
 190       SUBROUTINE RECO_INIT(seff,sb0,sbl3)
 191 *************************************************************************
 192       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 193
 194       CALL TRACKF_INIT(seff,sb0,sbl3)
 195
 196       CALL PREC_INIT
 197
 198       RETURN
 199       END
 200
 201 *************************************************************************
 202       SUBROUTINE TRACKF_INIT(seff,sb0,sbl3)
 203 *************************************************************************
 204       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 205 **
 206       PARAMETER(NBSTATION=5,NTRMAX=500)
 207 **
 208       COMMON/REVENT/IEVBKGI,NBKGMAX,MAXUPSEV
 209 **
 210       COMMON/MAGNET/BL3,B0
 211 **
 212       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
 213 **
 214       COMMON/FILED/FILERES,FILEBKG,FILEOUT,FILEMIN
 215 **
 216       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
 217      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
 218 **
 219       COMMON/TRACKSUM/NRES(5),NRESF,NTRMUALL,NMUONALL,NGHOSTALL,
 220      &     NTRACKFALL,NERRALL(NBSTATION),IR
 221 **
 222       COMMON/ACUTPXZ/ACUTPXZ
 223 **
 224       COMMON/DEBEVT/IDEBUG
 225 **
 226       CALL HIST_CREATE
 227 *
 228       EFF = SEFF
 229       B0 = SB0
 230       BL3 = SBL3
 231
 232       PXZCUT = ACUTPXZ
 233       AMAGLEN = ZMAGEND-ZCOIL
 234       ZM = AMAGLEN/2.+ZCOIL
 235       ALPHATOP = 0.01*0.3*B0*ABS(AMAGLEN)
 236       HTOP = ALPHATOP*ZM
 237       HCUT = ABS(HTOP)/PXZCUT
 238
 239       print*,'TRACK_INIT hcut= ',hcut
 240       print*,'TRACK_INIT eff = ',eff
 241       print*,'TRACK_INIT b0 = ',b0
 242       print*,'TRACK_INIT bl3 = ',bl3
 243       print*,'TRACK_INIT sigmacut = ',sigcut
 244       print*,'TRACK_INIT cutpxz = ',pxzcut
 245       print*,'TRACK_INIT xprec = ',xprec
 246       print*,'TRACK_INIT yprec = ',yprec
 247
 248       EFF2 = EFF**2               ! PROBA. DEUX CHAMBRES TOUCHES
 249       EFF1 = EFF2+2.*EFF*(1.-EFF) ! PROBA. AU MOINS UNE CHAMBRE TOUCHE
 250 ** Used only for stations 4 & 5
 251       PHIPREC   = SQRT(2.)*XPREC/DZ_PL(5) ! PHI = (OZ , PROJ. DANS XOZ)
 252       ALAMPREC  = SQRT(2.)*YPREC/DZ_PL(5) ! LAM = (OM , PROJ. DANS XOZ)
 253
 254       DO I = 1,5
 255          NRES(I) = 0
 256       ENDDO
 257       NRESF = 0
 258       NTRMUALL = 0
 259       NMUONALL = 0
 260       NGHOSTALL = 0
 261       NTRACKFALL = 0
 262       DO I = 1,NBSTATION
 263          NERRALL(I) = 0
 264       ENDDO
 265       IR = 0
 266 *
 267       RETURN
 268       END
 269
 270 *************************************************************************
 271       SUBROUTINE PREC_INIT
 272 *************************************************************************
 273 *
 274 *
 275 *************************************************************************
 276
 277       IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 278 *
 279       PARAMETER(NPLANE=10,NBSTATION=5)
 280 *
 281       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
 282 *
 283       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
 284      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
 285 *
 286       COMMON/PRECCUT/PCUT,PTCUT,CHI2CUT
 287 *
 288       COMMON/PRECSUM/NRESF1,NMUONALL1,NGHOSTALL1,NTRACKFALL1
 289 *
 290       COMMON/DEBEVT/IDEBUG
 291 *
 292
 293       DATA THICK/0.03D0/   ! X/X0=3%
 294 **      DATA THICK/0.02D0/   ! X/X0=2% chambre
 295
 296 **      DATA B0,BL3/10.,2.0/ ! Champ magnetique dans le dipole et dans L3 en kgauss
 297       DATA B0,BL3/7.,2.0/ ! Magnetic field in the dipole & L3 in kgauss
 298       DATA ZMAGS/805.0D0/,ZMAGE/1233.0D0/,ZABS/503.D0/ ! CCC not used when
 299                                                        ! magn. field map
 300 *      DATA ZMAGS/825.0D0/,ZMAGE/1125.0D0/,ZABS/503.D0/
 301       DATA XMAG/190.0D0/
 302
 303 **      DATA XPREC/0.0100D0/,YPREC/0.144337D0/ ! CCC
 304       DATA XPREC/0.0100D0/,YPREC/0.2D0/
 305
 306 * Input parameters
 307       CONST = 0.299792458D-3*B0*(ZMAGE-ZMAGS)
 308       J = 0
 309       DO I = 1,5
 310          J = J+1
 311          ZPLANEP(J) = -ZPLANE(I)
 312          J = J+1
 313          ZPLANEP(J) = -ZPLANE(I)+DZ_PL(I)
 314       ENDDO
 315
 316       do i=1,10
 317          print*,'zplanep(',i,')=',ZPLANEP(I)
 318       end do
 319
 320       PCUT = 3.        ! Coupure en PXZ muon (GeV/c)
 321       PTCUT = 0.       ! Coupure en Pt muon (GeV/c)
 322
 323       CHI2CUT = 1.E4  ! Coupure sur le CHI2 du fit
 324
 325       X01 = 18.8     ! C (cm)
 326       X02 = 10.397   ! Concrete (cm)
 327       X03 = 0.56     ! Plomb (cm)
 328       X04 = 47.26    ! Polyethylene (cm)
 329       X05 = 0.35     ! W (cm)
 330
 331 ** Calcul des parametres pour la correction de Branson de l'absorbeur
 332       ANBP = (315.**3-90.**3)/X01 +(467.**3-315.**3)/X02+
 333      &       (472.**3-467.**3)/X03+(477.**3-472.**3)/X04+
 334      &       (482.**3-477.**3)/X03+(487.**3-482.**3)/X04+
 335      &       (492.**3-487.**3)/X03+(497.**3-492.**3)/X04+
 336      &       (502.**3-497.**3)/X03
 337       ADBP = (315.**2-90.**2)/X01 +(467.**2-315.**2)/X02+
 338      &       (472.**2-467.**2)/X03+(477.**2-472.**2)/X04+
 339      &       (482.**2-477.**2)/X03+(487.**2-482.**2)/X04+
 340      &       (492.**2-487.**2)/X03+(497.**2-492.**2)/X04+
 341      &       (502.**2-497.**2)/X03
 342       ZBP1 = 2./3.*ANBP/ADBP
 343       ANBP = (315.**3-90.**3)/X01 +(467.**3-315.**3)/X02+
 344      &       (503.**3-467.**3)/X05
 345       ADBP = (315.**2-90.**2)/X01 +(467.**2-315.**2)/X02+
 346      &       (503.**2-467.**2)/X05
 347       ZBP2 = 2./3.*ANBP/ADBP
 348 *
 349       IF (IDEBUG.GE.1) THEN
 350          PRINT *,' PREC_INIT B0 (kgauss)',B0,' BL3 (kgauss)',BL3
 351          PRINT *,' PREC_INIT ZMAGE (cm)',ZMAGE,' ZMAGS (cm)',ZMAGS,
 352      &        ' XMAG (cm)',XMAG
 353          PRINT *,' PREC_INIT ZABS (cm)',ZABS,' ZBP1 (cm)',ZBP1,
 354      &        ' ZBP2 (cm)',ZBP2
 355          PRINT *,' PREC_INIT Radiation length absorber X01 (cm)',X01,
 356      &        ' X02 (cm)',X02
 357          PRINT *,' PREC_INIT X03(cm)',X03,' X04 (cm)',X04,' X05 (cm)',
 358      &           X05
 359          PRINT *,' PREC_INIT Radiation length chamber THICK (%)',
 360      &           THICK*100.
 361          PRINT *,' PREC_INIT XPREC (cm)',XPREC,' YPREC (cm)',YPREC
 362          PRINT *,' PREC_INIT Coupure en Pxz (GeV/c): ',PCUT
 363          PRINT *,' PREC_INIT Coupure en Pt (GeV/c): ',PTCUT
 364          PRINT *,' PREC_INIT Coupure en CHI2 : ',CHI2CUT
 365       ENDIF
 366
 367 *      PAUSE
 368
 369       NRESF1 = 0
 370       NMUONALL1 = 0
 371       NGHOSTALL1 = 0
 372       NTRACKFALL1 = 0
 373
 374 *  Magnetic Field Map GC
 375 **      OPEN (UNIT=40,FILE='data/field02.dat',
 376 **     &      STATUS='UNKNOWN')
 377
 378       CALL INITFIELD
 379
 380 **      CLOSE(40)
 381
 382       RETURN
 383       END
 384
 385 *************************************************************************
 386       SUBROUTINE RECO_READEVT(NEV,IDRES,IREADGEANT)
 387 *************************************************************************
 388 *
 389 *
 390 *************************************************************************
 391       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 392
 393       PARAMETER(NTRMAX=500)
 394
 395       PARAMETER (NBSTATION=5,MAXIDG=20000,MAXHITTOT=20000,
 396      &           MAXHITCH=10000,MAXHIT=1000,NBCHAMBER=10)
 397
 398       COMMON/RHITG/ITYPG(MAXIDG),XTRG(MAXIDG),YTRG(MAXIDG),
 399      &             PTOTG(MAXIDG),IDG(MAXIDG),IZCH(MAXIDG),
 400      &             PVERT1G(MAXIDG),PVERT2G(MAXIDG),PVERT3G(MAXIDG),
 401      &     ZVERTG(MAXIDG),NHITTOT1,CX(MAXIDG),CY(MAXIDG),CZ(MAXIDG),
 402      &     XGEANT(MAXIDG),YGEANT(MAXIDG),CLSIZE1(MAXIDG),CLSIZE2(MAXIDG)
 403
 404       DIMENSION TYPG(MAXIDG),ZCH(MAXIDG)
 405
 406       REAL*4 R1,R2
 407       DATA R1,R2/0.,1./
 408
 409       IF (IREADGEANT.eq.1) THEN  ! GEANT hits
 410
 411          CALL TRACKF_READ_GEANT(ITYPG,XTRG,YTRG,PTOTG,IDG,IZCH,PVERT1G,
 412      &        PVERT2G,PVERT3G,ZVERTG,NHITTOT1,CX,CY,CZ,IEVR,NEV,
 413      &        XGEANT,YGEANT,CLSIZE1,CLSIZE2)
 414       ELSE ! reconstructed hits
 415          CALL TRACKF_READ_SPOINT(ITYPG,XTRG,YTRG,PTOTG,IDG,IZCH,PVERT1G,
 416      &        PVERT2G,PVERT3G,ZVERTG,NHITTOT1,CX,CY,CZ,IEVR,NEV,
 417      &        XGEANT,YGEANT,CLSIZE1,CLSIZE2)
 418       ENDIF
 419
 420       do i=1,NHITTOT1
 421          TYPG(i)=ITYPG(i)
 422          call chfill(100,sngl(typg(i)),R1,R2)
 423          call chfill(101,sngl(ygeant(i)),R1,R2)
 424          call chfill(102,sngl(xgeant(i)),R1,R2)
 425          ZCH(i)=IZCH(i)
 426          call chfill(103,sngl(zch(i)),R1,R2)
 427          call chfill(104,sngl(ptotg(i)),R1,R2)
 428          call chfill(105,sngl(pvert2g(i)),R1,R2)
 429          call chfill(106,sngl(pvert1g(i)),R1,R2)
 430          call chfill(107,sngl(pvert3g(i)),R1,R2)
 431          call chfill(108,sngl(zvertg(i)),R1,R2)
 432          call chfill(109,sngl(ytrg(i)),R1,R2)
 433          call chfill(110,sngl(xtrg(i)),R1,R2)
 434       enddo
 435
 436       do i=1,NHITTOT1
 437          CALL CHFILL (999,SNGL(PTOTG(I)),R1,R2)
 438       enddo
 439
 440       CALL TRACKF_STAT(IDRES,IREADGEANT)
 441
 442       RETURN
 443       END
 444
 445 *************************************************************************
 446       SUBROUTINE TRACKF_STAT(IDRES,IREADGEANT)
 447 *************************************************************************
 448 *  Associate hits between two chambers inside a station
 449 *  Simulate spatial resolution and chamber efficiency
 450 *
 451 *************************************************************************
 452       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 453 *
 454       PARAMETER (NBSTATION=5,MAXIDG=20000,MAXHITTOT=20000,
 455      &           MAXHITCH=10000,MAXHIT=1000,NBCHAMBER=10)
 456 *
 457       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
 458      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
 459 *
 460       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
 461 *
 462 * HITS GEANT initiaux par chambre
 463       COMMON/RHITG/ITYPG(MAXIDG),XTRG(MAXIDG),YTRG(MAXIDG),
 464      &             PTOTG(MAXIDG),IDG(MAXIDG),IZCH(MAXIDG),
 465      &             PVERT1G(MAXIDG),PVERT2G(MAXIDG),PVERT3G(MAXIDG),
 466      &     ZVERTG(MAXIDG),NHITTOT1,CX(MAXIDG),CY(MAXIDG),CZ(MAXIDG),
 467      &     XGEANT(MAXIDG),YGEANT(MAXIDG),CLSIZE1(MAXIDG),CLSIZE2(MAXIDG)
 468
 469 * HITS GEANT associes par station
 470       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
 471      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
 472      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
 473      &            ZVERT(MAXHITTOT),NHITTOT
 474
 475 *
 476       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
 477      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
 478      &             IZM(NBSTATION,MAXHITCH),
 479      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
 480      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
 481 *
 482       COMMON/DEBEVT/IDEBUG
 483       common/dstation/idstation
 484 *
 485       DIMENSION RMIN(NBCHAMBER),RMAX1(NBCHAMBER)
 486       DIMENSION XMA(NBCHAMBER,MAXHITCH),YMA(NBCHAMBER,MAXHITCH),
 487      &          IMARK(NBCHAMBER,MAXHITCH)
 488 *
 489       DIMENSION IEFFI(MAXHITTOT)
 490       DIMENSION IH(NBCHAMBER,MAXHIT)
 491       DIMENSION NHIT(NBCHAMBER)
 492       DIMENSION DXMAX(NBSTATION),DYMAX(NBSTATION),VRES(2,5)
 493
 494       REAL*4 RNDM,RN,RN1,RN2,R1,R2
 495
 496 * Chambre 10 deg.
 497       DATA RMAX1/91.5,91.5,122.5,122.5,158.3,158.3,260.,260.,260.,260./
 498 * Zone de recherche entre deux plans d'une station
 499
 500 *      if (idstation.eq.8) then
 501 *         DATA DXMAX/1.,1.,1.2,2.4,2.4/ ! dz_ch = 8 cm
 502 *      else if (idstation.eq.20) then
 503          DATA DXMAX/1.5,1.5,3.,6.,6./ ! dz_ch = 20cm
 504 *      end if
 505
 506       DATA DYMAX/0.22,0.22,0.22,0.22,0.22/  ! CCC Upsilon dz_ch = 20 cm
 507
 508       DATA R1,R2/0.,1./
 509
 510
 511       ICH = 0
 512       DO IZ=1,5
 513          ICH = ICH+1
 514          RMIN(ICH) =  ABS(ZPLANE(IZ)*TAN(2.*ACOS(-1.)/180))
 515          IF (IZ.GT.2) RMIN(ICH) = 30.
 516          ICH = ICH+1
 517          RMIN(ICH) =  ABS(ZPLANE(IZ)*TAN(2.*ACOS(-1.)/180))
 518          IF (IZ.GT.2) RMIN(ICH) = 30.
 519       ENDDO
 520
 521 *  Initialisations
 522       DO ICH = 1,10
 523          NHIT(ICH) = 0
 524       ENDDO
 525
 526 *  1 ere boucle de lecture des hits initiaux
 527
 528
 529       IF (IREADGEANT.EQ.1) THEN
 530          DO I = 1,2
 531             DO J = 1,5
 532                VRES(I,J) = 0.
 533             ENDDO
 534          ENDDO
 535          IMU = 0
 536          DO I = 1,NHITTOT1
 537             ICH = IZCH(I)
 538             IZ = INT(FLOAT(ICH+1)/2.)
 539             IMOD = MOD(ICH,2)
 540
 541             IF (IMOD.NE.0.AND.IZ.LE.5) THEN
 542                CALL CHFILL2(1000+IZ,SNGL(XGEANT(I)),SNGL(YGEANT(I)),R2)
 543             ENDIF
 544             IF (ICH.EQ.9) THEN
 545                ISTAK = IDG(I)
 546                ISTAK = MOD(ISTAK,30000)
 547                ISTAK = MOD(ISTAK,10000)
 548
 549                IF ((ITYPG(I).EQ.5.OR.ITYPG(I).EQ.6).AND.
 550      &              ISTAK.EQ.IDRES) THEN ! upsilon
 551                   IMU = IMU+1
 552                   VRES(1,IMU) = XGEANT(I)
 553                   VRES(2,IMU) = YGEANT(I)
 554                ENDIF
 555             ENDIF
 556          ENDDO
 557       ENDIF
 558
 559
 560       DO I = 1,NHITTOT1 ! Boucle sur les hits GEANT de toutes les ch.
 561
 562 **        IF (ITYPG(I).NE.5.AND.ITYPG(I).NE.6) GOTO 1 ! CCC
 563
 564          ICH = IZCH(I)
 565
 566          IF (ICH.GT.10) GO TO 1
 567
 568          IF (IREADGEANT.EQ.1) THEN ! GEANT hits
 569
 570             IF (ICH.EQ.9.OR.ICH.EQ.10) THEN
 571                DNUM = 999.
 572                DO IM = 1,IMU
 573                   DNU = SQRT((XGEANT(I)-VRES(1,IM))**2+
 574      &                 (YGEANT(I)-VRES(2,IM))**2)
 575                   IF (DNU.LT.DNUM) DNUM = DNU
 576                ENDDO
 577                IF (DNUM.GT.50.) GO TO 1 ! discard hits far from MUONS
 578             ENDIF
 579
 580             CALL RANNOR(RN1,RN2)          ! CCC
 581             X = XGEANT(I)
 582             Y = YGEANT(I)
 583 *            X = XGEANT(I) + RN1 * XPREC
 584 *            Y = YGEANT(I) + RN2 * YPREC
 585 *     efficacite des chambres
 586             IEFFI(I) = 1
 587             RN = RNDM()
 588             IF (RN.GT.EFF) IEFFI(I) = 0
 589 **            IF (ICH.EQ.9.OR.ICH.EQ.10) THEN
 590 **               PRINT *,' HIT GEANT',' ICH=',ICH,' I=',I,' X =',X,' Y=',
 591 **     &              Y,' IDG=',IDG(I)
 592 **            ENDIF
 593
 594             IF (ITYPG(I).EQ.5.OR.ITYPG(I).EQ.6) THEN
 595                ISTAK = IDG(I)
 596                ISTAK = MOD(ISTAK,30000)
 597                ISTAK = MOD(ISTAK,10000)
 598
 599                IF (ISTAK.EQ.IDRES) then
 600                   dx=xgeant(i)-x
 601                   dy=ygeant(i)-y
 602                   IZ = INT(FLOAT(IZCH(i)+1)/2.)
 603                   ichx=110+IZ
 604                   ichy=120+IZ
 605                   call chfill(ichx,sngl(dy),R1,R2)
 606                   call chfill(ichy,sngl(dx),R1,R2)
 607                   if (iz.eq.1) call chfill(116,sngl(dy),R1,R2)
 608                   if (iz.eq.2) call chfill(117,sngl(dy),R1,R2)
 609                end if
 610             end if
 611
 612          ELSE  ! reconstructed hits
 613
 614             IEFFI(I) = 1
 615
 616             X = XTRG(I)
 617             Y = YTRG(I)
 618
 619 *     étude des hits geant avec un seul fichier
 620 *            CALL RANNOR(RN1,RN2)          ! CCCC
 621 *            X = XGEANT(I) + RN1 * XPREC
 622 *            Y = YGEANT(I) + RN2 * YPREC
 623
 624             IF (ITYPG(I).EQ.5.OR.ITYPG(I).EQ.6) THEN
 625                ISTAK = IDG(I)
 626                ISTAK = MOD(ISTAK,30000)
 627                ISTAK = MOD(ISTAK,10000)
 628
 629                IF (ISTAK.EQ.IDRES) then
 630                   dx=xgeant(i)-x
 631                   dy=ygeant(i)-y
 632                   IZ = INT(FLOAT(IZCH(i)+1)/2.)
 633                   ichx=110+IZ
 634                   ichy=120+IZ
 635                   call chfill(ichx,sngl(dy),R1,R2)
 636                   call chfill(ichy,sngl(dx),R1,R2)
 637                   if (iz.eq.1) call chfill(116,sngl(dy),R1,R2)
 638                   if (iz.eq.2) call chfill(117,sngl(dy),R1,R2)
 639                end if
 640             end if
 641
 642          ENDIF
 643
 644          R = SQRT(X**2+Y**2)
 645 **         IF (R.LT.RMIN(ICH).OR.R.GT.RMAX1(ICH)) then
 646 **            if (ich.le.10) then
 647 **               print*,'* chambre ',ich,' * hit ',i
 648 **               print*,'ityp=',itypg(i),' x=',X,' y=',Y
 649 **               print*,'R=',R,' RMIN=',RMIN(ICH),' RMAX1=',RMAX1(ICH)
 650 **            endif
 651 **            GO TO 1        ! CCC
 652 **         end if
 653
 654          NHIT(ICH) = NHIT(ICH)+1
 655          IH(ICH,NHIT(ICH)) = I
 656          XMA(ICH,NHIT(ICH)) = X
 657          YMA(ICH,NHIT(ICH)) = Y
 658          IMARK(ICH,NHIT(ICH)) = 0
 659
 660   1      CONTINUE
 661       ENDDO
 662
 663 * Association des hits entre chambres d'une station
 664       II = 0            ! nombre de hits GEANT par station
 665       DO ICH1 = 1,10,2  ! loop on chamber
 666          IZ = INT(FLOAT(ICH1+1)/2.)
 667          JHIT(IZ) = 0
 668          ICH2 = ICH1+1
 669
 670          DO I1 = 1,NHIT(ICH1) ! loop on hits in 1st chamber
 671             II = II+1
 672             IFIND = 0
 673             I = IH(ICH1,I1)
 674
 675             ITYP(II) = ITYPG(I)
 676             XTR(II) = XTRG(I)
 677             YTR(II) = YTRG(I)
 678             PTOT(II) = PTOTG(I)
 679             ID(II) = IDG(I)
 680             IZST(II) = IZ
 681             PVERT1(II) = PVERT1G(I)
 682             PVERT2(II) = PVERT2G(I)
 683             PVERT3(II) = PVERT3G(I)
 684             ZVERT(II) = ZVERTG(I)
 685
 686             IF (IEFFI(I).EQ.1) THEN
 687                X1 = XMA(ICH1,I1)
 688                Y1 = YMA(ICH1,I1)
 689                ID1 = IDG(I)
 690                XEXT1 = (ZPLANE(IZ)-DZ_PL(IZ))/ZPLANE(IZ)*X1
 691                YEXT1 = (ZPLANE(IZ)-DZ_PL(IZ))/ZPLANE(IZ)*Y1
 692
 693                DO I2 = 1,NHIT(ICH2)  ! loop on hits in 2nd chamber
 694                   J = IH(ICH2,I2)
 695
 696                   IF (IEFFI(J).EQ.1) THEN
 697                      X2 = XMA(ICH2,I2)
 698                      Y2 = YMA(ICH2,I2)
 699                      ID2 = IDG(J)
 700                      DX = X2-XEXT1
 701                      DY = Y2-YEXT1
 702
 703                      IF (ID1.EQ.ID2.AND.
 704      &                    (ITYP(II).EQ.5.OR.ITYP(II).EQ.6)) THEN
 705                         CALL CHFILL(70+IZ,SNGL(DX),R1,R2)
 706                         CALL CHFILL(80+IZ,SNGL(DY),R1,R2)
 707                      ENDIF
 708                      DX = ABS(DX)
 709                      DY = ABS(DY)
 710
 711                      IF (DX.LT.DXMAX(IZ).AND.DY.LT.(SIGCUT*DYMAX(IZ)) ! CCC
 712      &                   ) THEN
 713                         IFIND = 1
 714                         IMARK(ICH2,I2) = 1
 715                         JHIT(IZ) =  JHIT(IZ)+1
 716                         XM(IZ,JHIT(IZ)) = X1
 717                         YM(IZ,JHIT(IZ)) = Y1
 718                         IZM(IZ,JHIT(IZ)) = 1
 719                         PHM(IZ,JHIT(IZ)) = -ATAN((X2-X1)/DZ_PL(IZ))
 720                         ALM(IZ,JHIT(IZ)) = ATAN((Y2-Y1)/DZ_PL(IZ)*
 721      &                                     COS(PHM(IZ,JHIT(IZ))))
 722                         XMR(IZ,JHIT(IZ),1) = X1
 723                         YMR(IZ,JHIT(IZ),1) = Y1
 724                         XMR(IZ,JHIT(IZ),2) = X2
 725                         YMR(IZ,JHIT(IZ),2) = Y2
 726                         IP(IZ,JHIT(IZ)) = II
 727
 728                         ISTAK = ID2
 729                         ISTAK = MOD(ISTAK,30000)
 730                         ISTAK = MOD(ISTAK,10000)
 731
 732                         IF ((ITYPG(J).EQ.5.OR.ITYPG(J).EQ.6).AND.
 733      &                       ISTAK.EQ.IDRES) THEN ! upsilon or J/psi
 734
 735                            ITYP(II) = ITYPG(J)
 736                            XTR(II) = XTRG(J)
 737                            YTR(II) = YTRG(J)
 738                            PTOT(II) = PTOTG(J)
 739                            ID(II) = IDG(J)
 740                            PVERT1(II) = PVERT1G(J)
 741                            PVERT2(II) = PVERT2G(J)
 742                            PVERT3(II) = PVERT3G(J)
 743                            ZVERT(II) = ZVERTG(J)
 744
 745                         ENDIF
 746
 747                      ENDIF
 748                   ENDIF
 749                ENDDO  ! loop on hits in 2nd chamber
 750
 751                IF (IFIND.EQ.0) THEN ! No possible association
 752                   JHIT(IZ) =  JHIT(IZ)+1
 753                   XM(IZ,JHIT(IZ)) = X1
 754                   YM(IZ,JHIT(IZ)) = Y1
 755                   IZM(IZ,JHIT(IZ)) = 1
 756                   IP(IZ,JHIT(IZ)) = II
 757                   PHM(IZ,JHIT(IZ)) = 10.
 758                   ALM(IZ,JHIT(IZ)) = 10.
 759                   XMR(IZ,JHIT(IZ),1) = X1
 760                   YMR(IZ,JHIT(IZ),1) = Y1
 761                   XMR(IZ,JHIT(IZ),2) = 0.
 762                   YMR(IZ,JHIT(IZ),2) = 0.
 763                ENDIF
 764             ENDIF
 765          ENDDO  ! end loop on hits in 1st chamber
 766       ENDDO  ! end loop on chamber
 767
 768
 769 * On conserve les HITS (x,y) de la 2nde chambre des stations
 770
 771       DO ICH = 2,10,2 ! Loop on 2nd chambers
 772          IZ = INT(FLOAT(ICH+1)/2.)
 773          DO I = 1,NHIT(ICH) ! Loop on hits
 774             J = IH(ICH,I)
 775
 776             IF (IMARK(ICH,I).EQ.0) THEN ! hit not already associated
 777
 778                II = II+1
 779
 780                ITYP(II) = ITYPG(J)
 781                XTR(II) = XTRG(J)
 782                YTR(II) = YTRG(J)
 783                PTOT(II) = PTOTG(J)
 784                ID(II) = IDG(J)
 785                IZST(II) = IZ
 786                PVERT1(II) = PVERT1G(J)
 787                PVERT2(II) = PVERT2G(J)
 788                PVERT3(II) = PVERT3G(J)
 789                ZVERT(II) = ZVERTG(I)
 790
 791                IF (IEFFI(J).EQ.1) THEN
 792                   JHIT(IZ) =  JHIT(IZ)+1
 793                   XM(IZ,JHIT(IZ)) = XMA(ICH,I)
 794                   YM(IZ,JHIT(IZ)) = YMA(ICH,I)
 795                   IZM(IZ,JHIT(IZ)) = 2
 796                   PHM(IZ,JHIT(IZ)) = 10.
 797                   ALM(IZ,JHIT(IZ)) = 10.
 798                   IP(IZ,JHIT(IZ)) = II
 799                   XMR(IZ,JHIT(IZ),1) = 1000.
 800                   YMR(IZ,JHIT(IZ),1) = 1000.
 801                   XMR(IZ,JHIT(IZ),2) = XMA(ICH,I)
 802                   YMR(IZ,JHIT(IZ),2) = YMA(ICH,I)
 803                ENDIF
 804             ENDIF
 805          ENDDO ! End loop on hits
 806       ENDDO  ! End loop on 2nd chambers
 807
 808
 809       NHITTOT = II ! total number of hits in stations
 810 *
 811
 812       IF (IDEBUG.GE.2) THEN
 813          PRINT *,'TRACKF_STAT nb hits:',NHITTOT
 814       ENDIF
 815
 816 **      DO IZ = 5,5
 817 **         PRINT *,' IZ=',IZ,' JHIT(IZ)=',JHIT(IZ)
 818 **         DO J = 1,JHIT(IZ)
 819 **            II = IP(IZ,J)
 820 **            PRINT *,' HIT ASS.',' IZ=',IZ,' II=',II,' X =',
 821 **     &           XM(IZ,J),' Y=',YM(IZ,J),' ID=',ID(II)
 822 **            PRINT *,' HIT ASS.',' IZ=',IZ,' II=',II,' X1 =',
 823 **     &           XMR(IZ,J,1),' Y1=',YMR(IZ,J,1),' ID=',ID(II)
 824 **            PRINT *,' HIT ASS.',' IZ=',IZ,' II=',II,' X2 =',
 825 **     &           XMR(IZ,J,2),' Y2=',YMR(IZ,J,2),' ID=',ID(II)
 826 **         ENDDO
 827 **      ENDDO
 828
 829 **    DO IZ = 1,NBSTATION
 830 **       PRINT *,' IZ=',IZ,' JHIT(IZ)=',JHIT(IZ)
 831 **       DO J = 1,JHIT(IZ)
 832 **          PRINT *,' PHM(IZ,J)=',PHM(IZ,J),' ALM(IZ,J)=',ALM(IZ,J)
 833 **       ENDDO
 834 **     ENDDO
 835
 836       RETURN
 837       END
 838 *************************************************************************
 839       SUBROUTINE TRACKF_STAT_NEW(IDRES)
 840 *************************************************************************
 841 *  Associate hits between two chambers inside a station
 842 *  Simulate spatial resolution and chamber efficiency
 843 *
 844 *************************************************************************
 845       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 846 *
 847       PARAMETER (NBSTATION=5,MAXIDG=20000,MAXHITTOT=20000,
 848      &           MAXHITCH=10000,MAXHIT=1000,NBCHAMBER=10)
 849 *
 850       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
 851      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
 852 *
 853       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
 854 *
 855 * HITS GEANT initiaux par chambre
 856       COMMON/RHITG/ITYPG(MAXIDG),XTRG(MAXIDG),YTRG(MAXIDG),
 857      &             PTOTG(MAXIDG),IDG(MAXIDG),IZCH(MAXIDG),
 858      &             PVERT1G(MAXIDG),PVERT2G(MAXIDG),PVERT3G(MAXIDG),
 859      &     ZVERTG(MAXIDG),NHITTOT1,CX(MAXIDG),CY(MAXIDG),CZ(MAXIDG),
 860      &     XGEANT(MAXIDG),YGEANT(MAXIDG),CLSIZE1(MAXIDG),CLSIZE2(MAXIDG)
 861
 862 * HITS GEANT associes par station
 863       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
 864      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
 865      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
 866      &            ZVERT(MAXHITTOT),NHITTOT
 867
 868 *
 869       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
 870      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
 871      &             IZM(NBSTATION,MAXHITCH),
 872      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
 873      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
 874 *
 875       COMMON/DEBEVT/IDEBUG
 876 *
 877       DIMENSION RMIN(NBCHAMBER),RMAX1(NBCHAMBER)
 878       DIMENSION XMA(NBCHAMBER,MAXHITCH),YMA(NBCHAMBER,MAXHITCH),
 879      &          IMARK(NBCHAMBER,MAXHITCH)
 880 *
 881       DIMENSION IEFFI(MAXHITTOT)
 882       DIMENSION IH(NBCHAMBER,MAXHIT)
 883       DIMENSION NHIT(NBCHAMBER)
 884       DIMENSION DXMAX(NBSTATION),DYMAX(NBSTATION),I2C(1000)
 885
 886       DIMENSION DIST(2),NMUON(2),NHITMUON(2,5),NMUONGOOD(2)
 887
 888       REAL*4 RNDM,RN,RN1,RN2,R1,R2
 889
 890 * Chambre 10 deg.
 891       DATA RMAX1/91.5,91.5,122.5,122.5,158.3,158.3,260.,260.,260.,260./
 892 * Zone de recherche entre deux plans d'une station
 893 **      DATA DXMAX/2.,1.5,2.5,3.,3./
 894       DATA DXMAX/1.5,1.5,3.,3.,3./
 895       DATA DYMAX/0.22,0.22,0.21,0.21,0.21/
 896       DATA R1,R2/0.,1./
 897
 898       ICH = 0
 899       DO IZ=1,5
 900          ICH = ICH+1
 901          RMIN(ICH) =  ABS(ZPLANE(IZ)*TAN(2.*ACOS(-1.)/180))
 902          IF (IZ.GT.2) RMIN(ICH) = 30.
 903          ICH = ICH+1
 904          RMIN(ICH) =  ABS(ZPLANE(IZ)*TAN(2.*ACOS(-1.)/180))
 905          IF (IZ.GT.2) RMIN(ICH) = 30.
 906       ENDDO
 907
 908 *    Initialisations
 909       DO ICH = 1,10
 910          NHIT(ICH) = 0
 911       ENDDO
 912
 913       DO NCH = 1,10
 914          DO J=1,2
 915             DIST(J)=999.
 916             NMUON(J)=0
 917          ENDDO
 918          DO I = 1,NHITTOT1
 919             IF (IZCH(I).EQ.NCH) THEN
 920                ISTAK = IDG(I)
 921                ISTAK = MOD(ISTAK,30000)
 922                ISTAK = MOD(ISTAK,10000)
 923                IF (ISTAK.EQ.IDRES.AND.IDG(I).EQ.50116) THEN
 924                   DISTMIN=(XTRG(I)-XGEANT(I))**2+(YTRG(I)-YGEANT(I))**2
 925                   IF (DISTMIN.LT.DIST(1)) THEN
 926                      DIST(1)=DISTMIN
 927                      NMUONGOOD(1)=I
 928                   ENDIF
 929                   NMUON(1)=NMUON(1)+1
 930                   NHITMUON(1,NMUON(1))=I
 931                ELSE
 932                 IF (ISTAK.EQ.IDRES.AND.IDG(I).EQ.70116) THEN
 933                    DISTMIN=(XTRG(I)-XGEANT(I))**2+(YTRG(I)-YGEANT(I))**2
 934                    IF (DISTMIN.LT.DIST(2)) THEN
 935                         DIST(2)=DISTMIN
 936                         NMUONGOOD(2)=I
 937                    ENDIF
 938                    NMUON(2)=NMUON(2)+1
 939                    NHITMUON(2,NMUON(2))=I
 940                   ENDIF
 941                ENDIF
 942             ENDIF
 943          ENDDO
 944          DO J=1,2
 945             IF (NMUON(J).GE.2) THEN
 946              print*,'j=',j,' nmuon=',nmuon(j)
 947              print*,'chambre',nch
 948              DO K=1,NMUON(J)
 949                IF (NHITMUON(J,K).NE.NMUONGOOD(J)) IDG(NHITMUON(J,K))=999 ! flag les mauvais hits MUONS
 950              ENDDO
 951             ENDIF
 952          ENDDO
 953       ENDDO
 954
 955
 956 * 1 ere boucle Lecture des hits initiaux
 957
 958       DO I = 1,NHITTOT1 ! Boucle sur les hits GEANT de toutes les ch.
 959
 960          ICH = IZCH(I)
 961
 962          X = XTRG(I)
 963          Y = YTRG(I)
 964
 965          R = SQRT(X**2+Y**2)
 966          IF (R.LT.RMIN(ICH).OR.R.GT.RMAX1(ICH)) then
 967             if (ich.le.10.and.i.le.28) then
 968                print*,'****** chambre ',ich,' ****** hit ',i
 969                print*,'ityp=',itypg(i)
 970                print*,'x=',XTRG(I),' y=',YTRG(I)
 971                print*,'R=',R,' RMIN=',RMIN(ICH),' RMAX1=',RMAX1(ICH)
 972            endif
 973             GO TO 1
 974          end if
 975
 976          IEFFI(I) = 1
 977
 978          NHIT(ICH) = NHIT(ICH)+1
 979          IH(ICH,NHIT(ICH)) = I
 980          XMA(ICH,NHIT(ICH)) = XTRG(I)
 981          YMA(ICH,NHIT(ICH)) = YTRG(I)
 982          IMARK(ICH,NHIT(ICH)) = 0
 983
 984          print*,' XTRG(I)=', XTRG(I),' YTRG(I)=', YTRG(I),' IDG(I)=',
 985      &        IDG(I),' ICH=',ICH
 986
 987   1      CONTINUE
 988       ENDDO
 989
 990
 991 * Association des hits entre chambres d'une station
 992       II = 0            ! nombre de hits GEANT par station
 993       DO ICH1 = 1,10,2
 994          IZ = INT(FLOAT(ICH1+1)/2.)
 995          JHIT(IZ) = 0
 996          ICH2 = ICH1+1
 997
 998          DO I1 = 1,NHIT(ICH1)
 999             II = II+1
1000             IFIND = 0
1001             I = IH(ICH1,I1)
1002
1003             ITYP(II) = ITYPG(I)
1004             XTR(II) = XTRG(I)
1005             YTR(II) = YTRG(I)
1006             PTOT(II) = PTOTG(I)
1007             ID(II) = IDG(I)
1008             IZST(II) = IZ
1009             PVERT1(II) = PVERT1G(I)
1010             PVERT2(II) = PVERT2G(I)
1011             PVERT3(II) = PVERT3G(I)
1012             ZVERT(II) = ZVERTG(I)
1013
1014             IF (IEFFI(I).EQ.1) THEN
1015                X1 = XMA(ICH1,I1)
1016                Y1 = YMA(ICH1,I1)
1017                ID1 = IDG(I)
1018                XEXT1 = (ZPLANE(IZ)-DZ_PL(IZ))/ZPLANE(IZ)*X1
1019                YEXT1 = (ZPLANE(IZ)-DZ_PL(IZ))/ZPLANE(IZ)*Y1
1020                KC = 0
1021                PRINT *,'***** DEBUT RECHERCHE',' ID1=',ID1,' ich1=',ICH1
1022                PRINT *,' XTR(II)=', XTR(II),' YTR(II)=', YTR(II)
1023                PRINT *,'  ITYP(II)=', ITYP(II)
1024                DO I2 = 1,NHIT(ICH2)
1025                   J = IH(ICH2,I2)
1026                   IF (IEFFI(J).EQ.1) THEN
1027                      X2 = XMA(ICH2,I2)
1028                      DX = X2-XEXT1
1029                      DX = ABS(DX)
1030                      IF (DX.LT.DXMAX(IZ)) THEN
1031                         KC = KC + 1
1032                         I2C(KC) = I2
1033                         ID2 = IDG(J)
1034                         print *,' DX=',DX,' KC=',KC,' ID2=',ID2
1035                      ENDIF
1036                   ENDIF
1037                ENDDO
1038                DYOLD = 999.
1039                I2FIND = 0
1040                DO IKC = 1,KC
1041                   I2 = I2C(IKC)
1042                   Y2 = YMA(ICH2,I2)
1043                   DY = Y2-YEXT1
1044                   DY = ABS(DY)
1045                   J = IH(ICH2,I2)
1046                   ID2 = IDG(J)
1047                   IF (DY.LT.DYOLD.AND.DY.LT.(SIGCUT*DYMAX(IZ))) THEN
1048                      DYOLD = DY
1049                      I2FIND = I2
1050                      PRINT *,' ID2=',ID2,' DY=',DY
1051                   ENDIF
1052                ENDDO
1053                IF (I2FIND.GT.0) THEN
1054                   I2 = I2FIND
1055                   J = IH(ICH2,I2)
1056                   ID2 = IDG(J)
1057                   IFIND = 1
1058                   IMARK(ICH2,I2) = 1
1059                   JHIT(IZ) =  JHIT(IZ)+1
1060                   X2 = XMA(ICH2,I2)
1061                   Y2 = YMA(ICH2,I2)
1062                   XM(IZ,JHIT(IZ)) = X1
1063                   YM(IZ,JHIT(IZ)) = Y1
1064                   IZM(IZ,JHIT(IZ)) = 1
1065                   PHM(IZ,JHIT(IZ)) = -ATAN((X2-X1)/DZ_PL(IZ))
1066                   ALM(IZ,JHIT(IZ)) = ATAN((Y2-Y1)/DZ_PL(IZ)*
1067      &                 COS(PHM(IZ,JHIT(IZ))))
1068                   XMR(IZ,JHIT(IZ),1) = X1
1069                   YMR(IZ,JHIT(IZ),1) = Y1
1070                   XMR(IZ,JHIT(IZ),2) = X2
1071                   YMR(IZ,JHIT(IZ),2) = Y2
1072                   IP(IZ,JHIT(IZ)) = II
1073
1074                   ISTAK = ID2
1075                   ISTAK = MOD(ISTAK,30000)
1076                   ISTAK = MOD(ISTAK,10000)
1077 * test
1078                   IF (ISTAK.EQ.IDRES.AND.ID1.NE.999) THEN
1079
1080                      ITYP(II) = ITYPG(J)
1081                      PTOT(II) = PTOTG(J)
1082                      XTR(II) = XTRG(I)
1083                      YTR(II) = YTRG(I)
1084                      ID(II) = IDG(J)
1085                      PVERT1(II) = PVERT1G(J)
1086                      PVERT2(II) = PVERT2G(J)
1087                      PVERT3(II) = PVERT3G(J)
1088                      ZVERT(II) = ZVERTG(J)
1089
1090                   ENDIF
1091                ENDIF
1092
1093
1094
1095                IF (IFIND.EQ.0) THEN
1096                   JHIT(IZ) =  JHIT(IZ)+1
1097                   XM(IZ,JHIT(IZ)) = X1
1098                   YM(IZ,JHIT(IZ)) = Y1
1099                   IZM(IZ,JHIT(IZ)) = 1
1100                   IP(IZ,JHIT(IZ)) = II
1101                   PHM(IZ,JHIT(IZ)) = 10.
1102                   ALM(IZ,JHIT(IZ)) = 10.
1103                   XMR(IZ,JHIT(IZ),1) = X1
1104                   YMR(IZ,JHIT(IZ),1) = Y1
1105                   XMR(IZ,JHIT(IZ),2) = 0.
1106                   YMR(IZ,JHIT(IZ),2) = 0.
1107                ENDIF
1108                CALL CHFILL2(1000+IZ,SNGL(X1),SNGL(Y1),R2)
1109             ENDIF
1110          ENDDO
1111       ENDDO
1112
1113 * On conserve les HITS de la 2nde chambre des stations
1114
1115       DO ICH = 2,10,2
1116          IZ = INT(FLOAT(ICH+1)/2.)
1117          DO I = 1,NHIT(ICH)
1118             J = IH(ICH,I)
1119
1120             IF (IMARK(ICH,I).EQ.0) THEN
1121 **               print *,' ich=',ich,' i=',i,' j=',j
1122
1123                II = II+1
1124
1125                ITYP(II) = ITYPG(J)
1126                XTR(II) = XTRG(J)
1127                YTR(II) = YTRG(J)
1128                PTOT(II) = PTOTG(J)
1129                ID(II) = IDG(J)
1130                IZST(II) = IZ
1131                PVERT1(II) = PVERT1G(J)
1132                PVERT2(II) = PVERT2G(J)
1133                PVERT3(II) = PVERT3G(J)
1134                ZVERT(II) = ZVERTG(I)
1135
1136                IF (IEFFI(J).EQ.1) THEN
1137                   JHIT(IZ) =  JHIT(IZ)+1
1138 **                  XM(IZ,JHIT(IZ)) = ZPLANE(IZ)/(ZPLANE(IZ)-DZ_PL)
1139 **     &                              *XMA(ICH,I)
1140 **                  YM(IZ,JHIT(IZ)) = ZPLANE(IZ)/(ZPLANE(IZ)-DZ_PL)
1141 **     &                              *YMA(ICH,I)
1142                   XM(IZ,JHIT(IZ)) = XMA(ICH,I)
1143                   YM(IZ,JHIT(IZ)) = YMA(ICH,I)
1144                   IZM(IZ,JHIT(IZ)) = 2
1145                   PHM(IZ,JHIT(IZ)) = 10.
1146                   ALM(IZ,JHIT(IZ)) = 10.
1147                   IP(IZ,JHIT(IZ)) = II
1148                   XMR(IZ,JHIT(IZ),1) = 1000.
1149                   YMR(IZ,JHIT(IZ),1) = 1000.
1150                   XMR(IZ,JHIT(IZ),2) = XMA(ICH,I)
1151                   YMR(IZ,JHIT(IZ),2) = YMA(ICH,I)
1152                ENDIF
1153             ENDIF
1154          ENDDO
1155       ENDDO
1156
1157
1158       NHITTOT = II
1159 *
1160       IF (IDEBUG.GE.2) THEN
1161          PRINT *,'TRACKF_MICRO nb hits:',NHITTOT
1162       ENDIF
1163       DO IZ = 1,NBSTATION
1164          PRINT *,' IZ=',IZ,' JHIT(IZ)=',JHIT(IZ)
1165          DO J = 1,JHIT(IZ)
1166             II = IP(IZ,J)
1167             PRINT *,' ID(II)=',ID(II)
1168             PRINT *,' XMR(IZ,J,1)=', XMR(IZ,J,1),
1169      &            ' YMR(IZ,J,1)=', YMR(IZ,J,1)
1170             PRINT *,' XMR(IZ,J,2)=', XMR(IZ,J,2),
1171      &            ' YMR(IZ,J,2)=', YMR(IZ,J,2)
1172         ENDDO
1173       ENDDO
1174
1175       RETURN
1176       END
1177
1178 *************************************************************************
1179       SUBROUTINE RECO_TRACKF(IDRES,IREADGEANT)
1180 *************************************************************************
1181 *
1182 *
1183 *************************************************************************
1184       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
1185 *
1186       PARAMETER (MAXIDG=20000)
1187 *
1188       PARAMETER (MAXHITCH=10000,MAXTRK=50000,MAXHITTOT=20000,
1189      &           NBSTATION=5,MAXCAN=1000,NBCHAMBER=10,NTRMAX=500)
1190 *
1191       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
1192      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
1193      &             IZM(NBSTATION,MAXHITCH),
1194      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
1195      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
1196 *
1197       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
1198      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
1199      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
1200      &            ZVERT(MAXHITTOT),NHITTOT
1201
1202 *
1203       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
1204 *
1205       COMMON/VERIFGEANT/ITTROUGH(MAXTRK,NBSTATION),
1206      &                  IT_LIST(MAXTRK),IT_NP(MAXTRK),ITCHECK(MAXTRK),
1207      &                  ITRACK(MAXHITTOT)
1208 *
1209       COMMON/HCHHIT/HHIT(MAXHITCH),INDEXTAB(MAXHITCH),INDEXMAX
1210 *
1211       COMMON/PRECIS/EEXM(NBSTATION),EEYM(NBSTATION),EEPH(NBSTATION),
1212      &     EEAL(NBSTATION)
1213 *
1214       COMMON/MEASUR/XMES(NBSTATION),YMES(NBSTATION),IZMES(NBSTATION),
1215      &              PHMES(NBSTATION),ALMES(NBSTATION),MPOS(NBSTATION),
1216      &              MANG(NBSTATION)
1217 *
1218       COMMON/PLANE/XPL(NBSTATION,2),YPL(NBSTATION,2),
1219      &             PHPL(NBSTATION),ALPL(NBSTATION),CHI2PL
1220 *
1221       COMMON/CANDIDAT/JCAN(NBSTATION,MAXCAN),JCANTYP(MAXCAN),
1222      &          EEX(MAXCAN),EEY(MAXCAN),EEP(MAXCAN),EEA(MAXCAN)
1223 *
1224       COMMON /VERTEX/ERRV,IVERTEX
1225 *
1226       COMMON/TRACKSUM/NRES(5),NRESF,NTRMUALL,NMUONALL,NGHOSTALL,
1227      &     NTRACKFALL,NERRALL(NBSTATION),IR
1228 *
1229       COMMON/TRACKFOUT/IEVOUT,NTREVT,JJOUT(NBCHAMBER,NTRMAX),
1230      &               ISTAT(NTRMAX),PXZOUT(NTRMAX),TPHIOUT(NTRMAX),
1231      &               TALAMOUT(NTRMAX),XVERTOUT(NTRMAX),YVERTOUT(NTRMAX),
1232      &               CHI2OUT(NTRMAX),
1233      &               XMESOUT(NBCHAMBER,NTRMAX),YMESOUT(NBCHAMBER,NTRMAX)
1234      &              ,PXVOUT(NTRMAX),PYVOUT(NTRMAX),PZVOUT(NTRMAX)
1235 *
1236       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
1237      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
1238 *
1239       COMMON/DEBEVT/IDEBUG
1240       common/dstation/idstation
1241
1242       DIMENSION PEST(5),PSTEP(5),NERR(NBSTATION),IFIND2(10),NMU45(2)
1243       DIMENSION NMU345(2),NMUONF(2)
1244 *
1245       REAL*4 R2
1246       DATA R2/1./
1247
1248 ** GEANT informations
1249       DO I = 1,MAXTRK
1250          IT_LIST(I)= 0  ! ID of the GEANT tracks
1251       ENDDO
1252       DO I = 1,MAXHITTOT
1253          ITRACK(I) = 0  ! Track number associated to hit number I
1254       ENDDO
1255
1256       NTRTOT = 0
1257 *  BOUCLE SUR LES HITS
1258       DO IH = 1,NHITTOT
1259          DO IT = 1,NTRTOT
1260             IF (ID(IH).EQ.IT_LIST(IT))  THEN
1261                IT1 = IT
1262                GOTO 4
1263             ENDIF
1264          ENDDO
1265          NTRTOT = NTRTOT +1     ! NB de trace GEANT
1266          IT_LIST(NTRTOT) = ID(IH) ! ID DE LA TRACE NTRTOT
1267          IT_NP(NTRTOT) = 0      ! NOMBRE DE HITS PAR TRACE
1268          DO II=1,NBSTATION
1269             ITTROUGH(NTRTOT,II) = 0
1270          ENDDO
1271          IT1 = NTRTOT
1272  4       IT_NP(IT1) = IT_NP(IT1)+1 ! Number of crossed stations per track
1273          ITTROUGH(IT1,IZST(IH))=IH ! =IH si la trace IT touche le plan IZST
1274          ITRACK(IH) = IT1
1275       ENDDO
1276       IF (IDEBUG.GE.2) THEN
1277          PRINT *,'RECO_TRACKF nb total de trace GEANT:',NTRTOT
1278       ENDIF
1279
1280       NTRPART=0
1281       NTRMU = 0
1282
1283       DO IT = 1,NTRTOT
1284          ITCHECK(IT) = 0
1285          IF ((ITTROUGH(IT,1)*ITTROUGH(IT,2)*ITTROUGH(IT,3)*
1286      &        ITTROUGH(IT,4)*ITTROUGH(IT,5)).NE.0)
1287      &        THEN  ! track crossing all stations
1288             NTRPART=NTRPART+1
1289             IH = ITTROUGH(IT,NBSTATION)
1290             IF (ITYP(IH).EQ.5.OR.ITYP(IH).EQ.6) THEN
1291                ISTAK = ID(IH)
1292                ISTAK = MOD(ISTAK,30000)
1293                ISTAK = MOD(ISTAK,10000)
1294 *     test
1295                pt=sqrt(pvert1(ih)**2+pvert2(ih)**2)
1296                thet=datan2(pt,pvert3(ih))*180/3.1416
1297                pp=sqrt(pt**2+pvert3(ih)**2)
1298
1299                IF (ISTAK.EQ.IDRES) THEN ! psi or upsilon
1300                   NTRMU = NTRMU+1
1301                   NTRMUALL = NTRMUALL+1
1302                   ITCHECK(IT) = 1
1303                ENDIF
1304             ENDIF
1305          ENDIF
1306       ENDDO
1307
1308       IF (IDEBUG.GE.2) THEN
1309          PRINT *,'RECO_TRACKF nb of part. GEANT crossing 5 st.:',
1310      &        NTRPART
1311          PRINT *,'RECO_TRACKF nb of muons/res. GEANT crossing 5 st.:',
1312      &        NTRMU
1313       ENDIF
1314
1315 **         CALL H_ACCEPTANCE(5)
1316 **         CALL H_ACCEPTANCE(4)
1317 **         PAUSE
1318
1319       NCAN = 0
1320
1321 *  Recherche 5 -> 4
1322       CALL ORDONNE_HIT(5,HCUT)
1323
1324       DO IH = 1,INDEXMAX
1325          JJ = INDEXTAB(IH)
1326          X1 = XM(5,JJ)-(ZPLANE(5)-ZPLANE(4))*TAN(PHM(5,JJ))
1327          Y1 = YM(5,JJ)+(ZPLANE(5)-ZPLANE(4))*TAN(ALM(5,JJ))
1328      &                                            /COS(PHM(5,JJ))
1329          X2 = XM(5,JJ)-(ZPLANE(5)-ZPLANE(4)+DZ_PL(4))*TAN(PHM(5,JJ))
1330          Y2 = YM(5,JJ)+(ZPLANE(5)-ZPLANE(4)+DZ_PL(4))*TAN(ALM(5,JJ))
1331      &                                            /COS(PHM(5,JJ))
1332
1333 *  Domaine de recherche dans la st. 4
1334          HCONST = 0.0136*SQRT(0.06)/HTOP  ! -> X/X0=0.03 % / chamber
1335          EPH2 = 2.0*PHIPREC**2  + (HCONST*HHIT(JJ))**2
1336          EAL2 = 2.0*ALAMPREC**2 + (HCONST*HHIT(JJ))**2
1337          EXM12 = (PHIPREC**2+(HCONST*HHIT(JJ))**2)*
1338      &        (ZPLANE(5)-ZPLANE(4))**2 + XPREC**2
1339          EYM12 = (ALAMPREC**2+(HCONST*HHIT(JJ))**2)*
1340      &        (ZPLANE(5)-ZPLANE(4))**2 + YPREC**2
1341          EXM22 = (PHIPREC**2+(HCONST*HHIT(JJ))**2)*
1342      &        (ZPLANE(5)-ZPLANE(4)+DZ_PL(4))**2 + XPREC**2
1343          EYM22 = (ALAMPREC**2+(HCONST*HHIT(JJ))**2)*
1344      &        (ZPLANE(5)-ZPLANE(4)+DZ_PL(4))**2 + YPREC**2
1345
1346          EPH = SIGCUT*SQRT(EPH2)
1347          EAL = SIGCUT*SQRT(EAL2)
1348          EX1 = SIGCUT*SQRT(EXM12)
1349          EY1 = SIGCUT*SQRT(EYM12)
1350          EX2 = SIGCUT*SQRT(EXM22)
1351          EY2 = SIGCUT*SQRT(EYM22)
1352
1353 **         P2 = (HTOP/HHIT(JJ))**2
1354
1355 **         EPH=SIGCUT*SQRT(9.14D-7+1.2D-3/P2)
1356 **         EAL=SIGCUT*SQRT(1.84D-4)
1357 **         EX1=SIGCUT*SQRT(1.95D-2+6.37/P2)
1358 **         EY1=SIGCUT*SQRT(3.89+151./P2)
1359 **         EX2=EX1
1360 **         EY2=EY2
1361
1362 * renvoie le num de hit de 4 le plus pres dans le domaine de recherche
1363
1364          CALL DISTMIN4(X1,Y1,PHM(5,JJ),ALM(5,JJ),4,EX1,EY1,EPH,EAL,
1365      &        IFIND,IFIND2)
1366          P1 = PTOT(IP(5,JJ))
1367          CALL CHECK_HISTO4(11,4,IFIND,5,JJ,X1,Y1,PHM(5,JJ),ALM(5,JJ),P1,
1368      &                     EX1,EY1,EPH,EAL)
1369          IF (IFIND.GT.0) THEN
1370             CALL STOCK_CANDIDAT(5,JJ,4,IFIND,IFIND2,EX1,EY1,EPH,EAL,
1371      &           NCAN,1)
1372          ELSE
1373             CALL DISTMIN2(X1,Y1,X2,Y2,4,EX1,EY1,EX2,EY2,IFIND,IFIND2)
1374             CALL CHECK_HISTO2(0,4,IFIND,5,JJ,X1,Y1,X2,Y2,P1,EX1,EY1,
1375      &           EX2,EY2)
1376             IF (IFIND.GT.0) THEN
1377                CALL STOCK_CANDIDAT(5,JJ,4,IFIND,IFIND2,EX1,EY1,EPH,EAL,
1378      &              NCAN,2)
1379             ENDIF
1380          ENDIF
1381       ENDDO
1382
1383 *   Recherche 4 -> 5
1384
1385       CALL ORDONNE_HIT(4,HCUT)
1386
1387       DO IH = 1,INDEXMAX
1388          JJ = INDEXTAB(IH)
1389          X1 = XM(4,JJ)-(ZPLANE(4)-ZPLANE(5))*TAN(PHM(4,JJ))
1390          Y1 = YM(4,JJ)+(ZPLANE(4)-ZPLANE(5))*TAN(ALM(4,JJ))
1391      &                                            /COS(PHM(4,JJ))
1392          X2 = XM(4,JJ)-(ZPLANE(4)-ZPLANE(5)+DZ_PL(5))*TAN(PHM(4,JJ))
1393          Y2 = YM(4,JJ)+(ZPLANE(4)-ZPLANE(5)+DZ_PL(5))*TAN(ALM(4,JJ))
1394      &                                            /COS(PHM(4,JJ))
1395 *   Domaine de recherche dans la st. 5
1396          HCONST = 0.0136*SQRT(0.06)/HTOP  ! -> X/X0=0.03 / chamber
1397 **         EPH2 = 2.0*PHIPREC**2  + (HCONST*HHIT(JJ))**2
1398 **         EAL2 = 2.0*ALAMPREC**2 + (HCONST*HHIT(JJ))**2
1399 **         EX12 = 2.0*(XPREC/SQRT(2.))**2
1400 **     &          + (ZPLANE(5)-ZPLANE(4))**2/2.*EPH2
1401 **         EY12 = 2.0*YPREC**2 + (ZPLANE(5)-ZPLANE(4))**2/2.*EAL2
1402 **         EX22 = 2.0*(XPREC/SQRT(2.))**2
1403 **     &          + (ZPLANE(5)-ZPLANE(4)-DZ_PL(5))**2/2.*EPH2
1404 **         EY22 = 2.0*YPREC**2 + (ZPLANE(5)-ZPLANE(4)-DZ_PL(5))**2/2.
1405 **     &        *EAL2
1406          EPH2 = 2.0*PHIPREC**2  + (HCONST*HHIT(JJ))**2
1407          EAL2 = 2.0*ALAMPREC**2 + (HCONST*HHIT(JJ))**2
1408          EXM12 = (PHIPREC**2+(HCONST*HHIT(JJ))**2)*
1409      &        (ZPLANE(5)-ZPLANE(4))**2 + XPREC**2
1410          EYM12 = (ALAMPREC**2+(HCONST*HHIT(JJ))**2)*
1411      &        (ZPLANE(5)-ZPLANE(4))**2 + YPREC**2
1412          EXM22 = (PHIPREC**2+(HCONST*HHIT(JJ))**2)*
1413      &        (ZPLANE(5)-ZPLANE(4)-DZ_PL(5))**2 + XPREC**2
1414          EYM22 = (ALAMPREC**2+(HCONST*HHIT(JJ))**2)*
1415      &        (ZPLANE(5)-ZPLANE(4)-DZ_PL(5))**2 + YPREC**2
1416
1417          EPH = SIGCUT*SQRT(EPH2)
1418          EAL = SIGCUT*SQRT(EAL2)
1419          EX1 = SIGCUT*SQRT(EXM12)
1420          EY1 = SIGCUT*SQRT(EYM12)
1421          EX2 = SIGCUT*SQRT(EXM22)
1422          EY2 = SIGCUT*SQRT(EYM22)
1423
1424
1425 **         P2 = (HTOP/HHIT(JJ))**2
1426
1427 **         EPH=SIGCUT*SQRT(9.14D-7+1.2D-3/P2)
1428 **         EAL=SIGCUT*SQRT(1.84D-4)
1429 **         EX1=SIGCUT*SQRT(1.95D-2+6.37/P2)
1430 **         EY1=SIGCUT*SQRT(3.89+151./P2)
1431 **         EX2=EX1
1432 **         EY2=EY2
1433 *   Renvoie le num de hit de 5 le plus pres dans le domaine de recherche
1434          CALL DISTMIN2(X1,Y1,X2,Y2,5,EX1,EY1,EX2,EY2,IFIND,IFIND2)
1435          P1 = PTOT(IP(4,JJ))
1436          CALL CHECK_HISTO2(0,5,IFIND,4,JJ,X1,Y1,X2,Y2,P1,EX1,EY1,
1437      &        EX2,EY2)
1438          IF (IFIND.GT.0) THEN
1439             DO ICAN=1,NCAN
1440                IF (IFIND.EQ.JCAN(5,ICAN).AND.JJ.EQ.JCAN(4,ICAN)) GOTO 40
1441 **               IF (JJ.EQ.JCAN(4,ICAN).AND.
1442 **     &              ABS(XM(5,JCAN(5,ICAN))-XM(5,IFIND)).LT.XPREC/10.)
1443 **     &            GO TO 40 ! elimine les doubles comptages de traces ccc
1444 **               IF (IFIND.EQ.JCAN(5,ICAN).AND.
1445 **     &              ABS(XM(4,JCAN(4,ICAN))-XM(4,JJ)).LT.XPREC/10.)
1446 **     &            GO TO 40 ! elimine les doubles comptages de traces ccc
1447
1448                DIST1 = SQRT(((XM(5,JCAN(5,ICAN))-XM(5,IFIND))
1449      &              /(0.1*XPREC))**2+((YM(5,JCAN(5,ICAN))-YM(5,IFIND))
1450      &              /(0.1*YPREC))**2)
1451                DIST2 = SQRT(((XM(4,JCAN(4,ICAN))-XM(4,JJ))
1452      &              /(0.1*XPREC))**2+((YM(4,JCAN(4,ICAN))-YM(4,JJ))
1453      &              /(0.1*YPREC))**2)
1454                IF (DIST1.LT.2..AND.DIST2.LT.2.)
1455      &            GO TO 40 ! elimine les doubles comptages de traces ccc
1456             ENDDO
1457             CALL STOCK_CANDIDAT(4,JJ,5,IFIND,IFIND2,EX1,EY1,EPH,EAL,NCAN
1458      &           ,3)
1459          ENDIF
1460 40       CONTINUE
1461       ENDDO
1462
1463
1464       NMU45(1) = 0
1465       NMU45(2) = 0
1466       DO ICAN = 1,NCAN
1467          JJ4 = JCAN(4,ICAN)
1468          JJ5 = JCAN(5,ICAN)
1469          IF (JJ4.GT.0.AND.JJ5.GT.0) THEN
1470             ID4 = ID(IP(4,JJ4))
1471             ID5 = ID(IP(5,JJ5))
1472             IT = ITRACK(IP(5,JJ5))
1473             IF (ITCHECK(IT).EQ.1) THEN
1474                IF (ID4.EQ.ID5) THEN
1475                   IF (ITYP(IP(5,JJ5)).EQ.5) NMU45(1) = 1
1476                   IF (ITYP(IP(5,JJ5)).EQ.6) NMU45(2) = 1
1477                ENDIF
1478             ENDIF
1479          ENDIF
1480       ENDDO
1481       IF (NMU45(1).GE.1.AND.NMU45(2).EQ.1) NRES(1) = NRES(1)+1
1482
1483       IF (IDEBUG.GE.2) THEN
1484          PRINT *,'RECO_TRACKF nb candidat recherche 4->5 et 5->4 :'
1485      &        ,NCAN
1486          PRINT *,'RECO_TRACKF nb of good muons 4->5 et 5->4 :'
1487      &        ,(NMU45(1)+NMU45(2))
1488
1489       ENDIF
1490
1491
1492       NMU345(1) = 0
1493       NMU345(2) = 0
1494 *
1495 * -- Boucle sur les candidats (4,5) NCAN
1496 *
1497       DO I = 1,NBSTATION
1498          NERR(I) = 0
1499       ENDDO
1500       NMUONF(1) = 0
1501       NMUONF(2) = 0
1502       NGHOST = 0
1503       NTRACKF = 0
1504
1505 **      GO TO 125 ! CCC
1506
1507       DO ICAN = 1,NCAN
1508          JJ1 = 0
1509          JJ2 = 0
1510          JJ3 = 0
1511          DO ICH = 1,NBSTATION
1512             MPOS(ICH) = 0
1513             MANG(ICH) = 0
1514          ENDDO
1515          MPOS(4) = 1
1516          MPOS(5) = 1
1517          MANG(4) = 1
1518          MANG(5) = 1
1519          IF (JCANTYP(ICAN).EQ.2) MANG(4)=0
1520          IF (JCANTYP(ICAN).EQ.3) MANG(5)=0
1521          EEXM(5) = EEX(ICAN)/SIGCUT
1522          EEYM(5) = EEY(ICAN)/SIGCUT
1523          EEPH(5) = EEP(ICAN)/SIGCUT
1524          EEAL(5) = EEA(ICAN)/SIGCUT
1525          EEXM(4) = EEX(ICAN)/SIGCUT
1526          EEYM(4) = EEY(ICAN)/SIGCUT
1527          EEPH(4) = EEP(ICAN)/SIGCUT
1528          EEAL(4) = EEA(ICAN)/SIGCUT
1529          JJ5 = JCAN(5,ICAN)
1530          JJ4 = JCAN(4,ICAN)
1531          P = PTOT(IP(5,JJ5))
1532          IF (IZM(4,JJ4).EQ.1) THEN
1533             ZPL4 = ZPLANE(4)
1534          ELSE
1535             ZPL4 = ZPLANE(4)-DZ_PL(4)
1536          ENDIF
1537          IF (IZM(5,JJ5).EQ.1) THEN
1538             ZPL5 = ZPLANE(5)
1539          ELSE
1540             ZPL5 = ZPLANE(5)-DZ_PL(5)
1541          ENDIF
1542          TPHEST = (XM(5,JJ5) - XM(4,JJ4))/(ZPL5-ZPL4)
1543          PHEST = ATAN(TPHEST)
1544          TALEST = -(YM(5,JJ5) - YM(4,JJ4))*COS(PHEST)
1545      &               /(ZPL5-ZPL4)
1546          PXZEST = -HTOP/(XM(4,JJ4) - ZPL4*TPHEST)
1547          PEST(1) = 1.0/PXZEST
1548          PEST(2) = TPHEST - ALPHATOP/PXZEST ! PHI emission au vertex
1549          PEST(3) = TALEST       ! tan(lambda)     !h=zm*ang deviation alpha
1550          PEST(4) = 0.0          !alpha=qbl/pxz
1551          PEST(5) = 0.0
1552          PSTEP(1) = 0.003       ! =d(1/p)=delta(p)/p**2
1553          PSTEP(2) = 0.001       ! 0.5 degre
1554          PSTEP(3) = 0.001       ! 0.5 degre
1555          PSTEP(4) = 0.0
1556          PSTEP(5) = 1.0
1557          XMES(4) = XM(4,JJ4)
1558          YMES(4) = YM(4,JJ4)
1559          IZMES(4) = IZM(4,JJ4)
1560          PHMES(4) = PHM(4,JJ4)
1561          ALMES(4) = ALM(4,JJ4)
1562          XMES(5) = XM(5,JJ5)
1563          YMES(5) = YM(5,JJ5)
1564          IZMES(5) = IZM(5,JJ5)
1565          PHMES(5) = PHM(5,JJ5)
1566          ALMES(5) = ALM(5,JJ5)
1567
1568          IVERTEX = 0 ! Vertex = (0,0,0)
1569
1570 * -- Fit 4,5,V pour la recherche dans 3
1571
1572          CALL TRACKF_FIT(IVERTEX,PEST,PSTEP,PXZINV45,TPHI45,TALAM45,
1573      &        XVERT,YVERT)
1574
1575 * -- Recherche dans la station 3
1576
1577          P2 = (1.0D0 + TALAM45**2)/(PXZINV45**2) ! P**2
1578
1579          if (idstation.eq.8) then !  DZ_CH = 8 CM
1580             EPH=SIGCUT*SQRT(3.6D-6+0.011/P2)
1581             EAL=SIGCUT*SQRT(6.85D-4)
1582             EXM=SIGCUT*SQRT(0.034+446./P2)
1583             EYM=SIGCUT*SQRT(0.049+354./P2)
1584          else if (idstation.eq.20) then ! DZ_CH = 20 CM
1585             EPH=SIGCUT*SQRT(4.1D-7+0.015/P2)
1586             EAL=SIGCUT*SQRT(1.04D-4)
1587             EXM=SIGCUT*SQRT(0.0+459./P2)
1588             EYM=SIGCUT*SQRT(0.042+345./P2)
1589          end if
1590
1591          EEXM(3) = EXM/SIGCUT
1592          EEYM(3) = EYM/SIGCUT
1593          EEPH(3) = EPH/SIGCUT
1594          EEAL(3) = EAL/SIGCUT
1595 **         DO IEX = 4,5
1596 **            EEXM(IEX) = EEXM(3)
1597 **            EEYM(IEX) = EEYM(3)
1598 **            EEPH(IEX) = EEPH(3)
1599 **            EEAL(IEX) = EEAL(3)
1600 **         ENDDO
1601          X1 = XPL(3,1)
1602          Y1 = YPL(3,1)
1603          X2 = XPL(3,2)
1604          Y2 = YPL(3,2)
1605          PHI1 = PHPL(3)
1606          ALAM1 = ALPL(3)
1607
1608          CALL DISTMIN4(X1,Y1,PHI1,ALAM1,3,EXM,EYM,EPH,EAL,IPA3,IFIND2)
1609
1610          P1 = PTOT(IP(5,JJ5))
1611
1612          CALL CHECK_HISTO4(61,3,IPA3,5,JJ5,X1,Y1,PHI1,ALAM1,P1,
1613      &        EXM,EYM,EPH,EAL)
1614
1615          IF (IPA3.NE.0) THEN
1616             JJ3 = IPA3
1617             XMES(3) = XM(3,JJ3)
1618             YMES(3) = YM(3,JJ3)
1619             IZMES(3) = IZM(3,JJ3)
1620             PHMES(3) = PHM(3,JJ3)
1621             ALMES(3) = ALM(3,JJ3)
1622             MPOS(3) = 1
1623             MANG(3) = 1
1624             GO TO 124
1625          ELSE
1626             CALL DISTMIN2(X1,Y1,X2,Y2,3,EXM,EYM,0.D0,0.D0,IP3,IFIND2)
1627             CALL CHECK_HISTO2(0,3,IP3,5,JJ5,X1,Y1,X2,Y2,P1,EXM,EYM,
1628      &           0.D0,0.D0)
1629          ENDIF
1630          IF (IP3.NE.0) THEN
1631             JJ3 = IP3
1632             XMES(3) = XM(3,JJ3)
1633             YMES(3) = YM(3,JJ3)
1634             IZMES(3) = IZM(3,JJ3)
1635             MPOS(3) = 1
1636             MANG(3) = 0
1637          ELSE
1638             GO TO 123
1639          ENDIF
1640
1641
1642 *     -- Fit 3,4,5 pour la recherche dans 2
1643
1644  124     CONTINUE
1645
1646          IF (JJ5.GT.0.AND.JJ4.GT.0.AND.JJ3.GT.0) THEN
1647             ID4 = ID(IP(4,JJ4))
1648             ID5 = ID(IP(5,JJ5))
1649             ID3 = ID(IP(3,JJ3))
1650             IT = ITRACK(IP(5,JJ5))
1651             IF (ITCHECK(IT).EQ.1) THEN
1652                IF ((ID5.EQ.ID3).AND.(ID5.EQ.ID4)) THEN
1653                   IF (ITYP(IP(5,JJ5)).EQ.5) NMU345(1) = 1
1654                   IF (ITYP(IP(5,JJ5)).EQ.6) NMU345(2) = 1
1655                ENDIF
1656             ENDIF
1657          ENDIF
1658
1659          IVERTEX = 1 ! CCC
1660
1661          PEST(1) = PXZINV45
1662          PEST(2) = TPHI45
1663          PEST(3) = TALAM45
1664          PEST(4) = 0.
1665          PEST(5) = 0.
1666          PSTEP(1) = 0.003
1667          PSTEP(2) = 0.001
1668          PSTEP(3) = 0.001
1669          PSTEP(4) = 1.
1670          PSTEP(5) = 1.
1671
1672          CALL TRACKF_FIT(IVERTEX,PEST,PSTEP,PXZINV345,TPHI345,
1673      &        TALAM345,XVERT,YVERT)
1674
1675 *     -- Recherche dans la st. 2
1676
1677          P2 = (1.0D0 + TALAM345**2)/(PXZINV345**2) ! P**2
1678
1679          if (idstation.eq.8) then !  DZ_CH = 8 CM
1680             EPH=SIGCUT*SQRT(3.63D-6+4.8D-3/P2)
1681             EAL=SIGCUT*SQRT(6.49D-4)
1682             EXM=SIGCUT*SQRT(1.64D-2+821./P2)
1683             EYM=SIGCUT*SQRT(4.83D-2+866./P2)
1684          else if (idstation.eq.20) then ! DZ_CH = 20 CM
1685             EPH=SIGCUT*SQRT(5.78D-7+5.97D-3/P2)
1686             EAL=SIGCUT*SQRT(1.D-4)
1687             EXM=SIGCUT*SQRT(0.+1453./P2)
1688             EYM=SIGCUT*SQRT(2.78D-2+504./P2)
1689          end if
1690
1691          EEXM(2) = EXM/SIGCUT
1692          EEYM(2) = EYM/SIGCUT
1693          EEPH(2) = EPH/SIGCUT
1694          EEAL(2) = EAL/SIGCUT
1695 **         DO IEX = 3,5
1696 **            EEXM(IEX) = EEXM(2)
1697 **            EEYM(IEX) = EEYM(2)
1698 **            EEPH(IEX) = EEPH(2)
1699 **            EEAL(IEX) = EEAL(2)
1700 **         ENDDO
1701
1702          X1 = XPL(2,1)
1703          Y1 = YPL(2,1)
1704          PHI1 = PHPL(2)
1705          ALAM1 = ALPL(2)
1706          CALL DISTMIN4(X1,Y1,PHI1,ALAM1,2,EXM,EYM,EPH,EAL,IPA2,IFIND2)
1707          P1 = PTOT(IP(5,JJ5))
1708          CALL CHECK_HISTO4(21,2,IPA2,5,JJ5,X1,Y1,PHI1,ALAM1,P1,
1709      &        EXM,EYM,EPH,EAL)
1710 *     -- Recherche dans la st. 1
1711
1712          if (idstation.eq.8) then !  DZ_CH = 8 CM
1713             EPH=SIGCUT*SQRT(3.54D-6+4.49D-3/P2)
1714             EAL=SIGCUT*SQRT(6.14D-4)
1715             EXM=SIGCUT*SQRT(6.43D-2+986./P2)
1716             EYM=SIGCUT*SQRT(4.66D-2+1444./P2)
1717          else if (idstation.eq.20) then ! DZ_CH = 20 CM
1718             EPH=SIGCUT*SQRT(4.96D-7+5.87D-3/P2)
1719             EAL=SIGCUT*SQRT(1.D-4)
1720             EXM=SIGCUT*SQRT(6.98D-4+1467./P2)
1721             EYM=SIGCUT*SQRT(5.22D-2+1013./P2)
1722          end if
1723
1724          EEXM(1) = EXM/SIGCUT
1725          EEYM(1) = EYM/SIGCUT
1726          EEPH(1) = EPH/SIGCUT
1727          EEAL(1) = EAL/SIGCUT
1728 **         DO IEX = 2,5
1729 **            EEXM(IEX) = EEXM(1)
1730 **            EEYM(IEX) = EEYM(1)
1731 **            EEPH(IEX) = EEPH(1)
1732 **            EEAL(IEX) = EEAL(1)
1733 **         ENDDO
1734
1735          X1 = XPL(1,1)
1736          Y1 = YPL(1,1)
1737          PHI1 = PHPL(1)
1738          ALAM1 = ALPL(1)
1739          CALL DISTMIN4(X1,Y1,PHI1,ALAM1,1,EXM,EYM,EPH,EAL,IPA1,IFIND2)
1740          CALL CHECK_HISTO4(31,1,IPA1,5,JJ5,X1,Y1,PHI1,ALAM1,P1,
1741      &        EXM,EYM,EPH,EAL)
1742 *     -- A partir de P+A dans la st. 2
1743          IPA2PA1 = 0
1744          IF (IPA2.GT.0) THEN
1745             PEST(1) = PXZINV345
1746             PEST(2) = TPHI345
1747             PEST(3) = TALAM345
1748             PEST(4) = 0.
1749             PEST(5) = 0.
1750             PSTEP(1) = 0.003
1751             PSTEP(2) = 0.001
1752             PSTEP(3) = 0.001
1753             PSTEP(4) = 1.
1754             PSTEP(5) = 1.
1755             XMES(2) = XM(2,IPA2)
1756             YMES(2) = YM(2,IPA2)
1757             IZMES(2) = IZM(2,IPA2)
1758             PHMES(2) = PHM(2,IPA2)
1759             ALMES(2) = ALM(2,IPA2)
1760             MPOS(2) = 1
1761             MANG(2) = 1
1762             IVERTEX = 1
1763 *     -- Fit V,2,3,4,5 pour la recherche dans 1
1764
1765             CALL TRACKF_FIT(IVERTEX,PEST,PSTEP,PXZINV,TPHI,TALAM,
1766      &           XVERT,YVERT)
1767
1768 *     !!! ATTENTION aux erreurs
1769
1770             P2 = (1.0D0 + TALAM**2)/(PXZINV**2)
1771
1772             if (idstation.eq.8) then !  DZ_CH = 8 CM
1773                EPH=SIGCUT*SQRT(3.15D-6+9.21D-3/P2)
1774                EAL=SIGCUT*SQRT(5.94D-4)
1775                EXM=SIGCUT*SQRT(4.16D-2+182./P2)
1776                EYM=SIGCUT*SQRT(2.13)
1777             else if (idstation.eq.20) then ! DZ_CH = 20 CM
1778                EPH=SIGCUT*SQRT(9.58D-7+8.93D-3/P2)
1779                EAL=SIGCUT*SQRT(1.D-4)
1780                EXM=SIGCUT*SQRT(1.92D-2+103.3/P2)
1781                EYM=SIGCUT*SQRT(6.3D-2+81.1/P2)
1782             end if
1783
1784             EEXM(1) = EXM/SIGCUT
1785             EEYM(1) = EYM/SIGCUT
1786             EEPH(1) = EPH/SIGCUT
1787             EEAL(1) = EAL/SIGCUT
1788 **            DO IEX = 2,5
1789 **               EEXM(IEX) = EEXM(1)
1790 **               EEYM(IEX) = EEYM(1)
1791 **               EEPH(IEX) = EEPH(1)
1792 **               EEAL(IEX) = EEAL(1)
1793 **            ENDDO
1794
1795             X1 = XPL(1,1)
1796             Y1 = YPL(1,1)
1797             X2 = XPL(1,2)
1798             Y2 = YPL(1,2)
1799             PHI1 = PHPL(1)
1800             ALAM1 = ALPL(1)
1801             CALL DISTMIN4(X1,Y1,PHI1,ALAM1,1,EXM,EYM,EPH,EAL,
1802      &           IPA2PA1,IFIND2)
1803             CALL CHECK_HISTO4(41,1,IPA2PA1,5,JJ5,X1,Y1,PHI1,ALAM1,
1804      &           P1,EXM,EYM,EPH,EAL)
1805             IF (IPA2PA1.GT.0) THEN
1806                JJ2 = IPA2
1807                JJ1 = IPA2PA1
1808
1809
1810                XMES(1) = XM(1,JJ1)
1811                YMES(1) = YM(1,JJ1)
1812                IZMES(1) = IZM(1,JJ1)
1813                PHMES(1) = PHM(1,JJ1)
1814                ALMES(1) = ALM(1,JJ1)
1815                MPOS(1) = 1
1816                MANG(1) = 1
1817                GOTO 123
1818             ELSE
1819                CALL DISTMIN2(X1,Y1,X2,Y2,1,EXM,EYM,0.D0,0.D0,IPA2P1,
1820      &              IFIND2)
1821                CALL CHECK_HISTO2(0,1,IPA2P1,5,JJ5,X1,Y1,X2,Y2,P1,
1822      &              EXM,EYM,0.D0,0.D0)
1823             ENDIF
1824          ENDIF
1825 *     --  A partir de P+A dans la st. 1
1826          IPA1PA2 = 0
1827          IF (IPA1.GT.0) THEN
1828             PEST(1) = PXZINV345
1829             PEST(2) = TPHI345
1830             PEST(3) = TALAM345
1831             PEST(4) = 0.
1832             PEST(5) = 0.
1833             PSTEP(1) = 0.003
1834             PSTEP(2) = 0.001
1835             PSTEP(3) = 0.001
1836             PSTEP(4) = 1.
1837             PSTEP(5) = 1.
1838             XMES(1) = XM(1,IPA1)
1839             YMES(1) = YM(1,IPA1)
1840             IZMES(1) = IZM(1,IPA1)
1841             PHMES(1) = PHM(1,IPA1)
1842             ALMES(1) = ALM(1,IPA1)
1843             MPOS(1) = 1
1844             MANG(1) = 1
1845             MPOS(2) = 0
1846             MANG(2) = 0
1847             IVERTEX = 1
1848 *     -- Fit V,1,3,4,5 pour la recherche dans 2
1849
1850             CALL TRACKF_FIT(IVERTEX,PEST,PSTEP,PXZINV,TPHI,TALAM,
1851      &           XVERT,YVERT)
1852
1853 *     !!! ATTENTION aux erreurs
1854
1855             P2 = (1.0D0 + TALAM**2)/(PXZINV**2)
1856
1857             if (idstation.eq.8) then !  DZ_CH = 8 CM
1858                EPH=SIGCUT*SQRT(3.15D-6+9.21D-3/P2)
1859                EAL=SIGCUT*SQRT(5.94D-4)
1860                EXM=SIGCUT*SQRT(4.16D-2+182./P2)
1861                EYM=SIGCUT*SQRT(2.13)
1862             else if (idstation.eq.20) then ! DZ_CH = 20 CM
1863                EPH=SIGCUT*SQRT(9.58D-7+8.93D-3/P2)
1864                EAL=SIGCUT*SQRT(1.D-4)
1865                EXM=SIGCUT*SQRT(4.0D-2+11.4/P2)
1866                EYM=SIGCUT*SQRT(5.5D-2+44.35/P2)
1867             end if
1868
1869             EEXM(2) = EXM/SIGCUT
1870             EEYM(2) = EYM/SIGCUT
1871             EEPH(2) = EPH/SIGCUT
1872             EEAL(2) = EAL/SIGCUT
1873 **            DO IEX = 1,5
1874 **               EEXM(IEX) = EEXM(2)
1875 **               EEYM(IEX) = EEYM(2)
1876 **               EEPH(IEX) = EEPH(2)
1877 **               EEAL(IEX) = EEAL(2)
1878 **            ENDDO
1879
1880             X1 = XPL(2,1)
1881             Y1 = YPL(2,1)
1882             X2 = XPL(2,2)
1883             Y2 = YPL(2,2)
1884             PHI1 = PHPL(2)
1885             ALAM1 = ALPL(2)
1886
1887             CALL DISTMIN4(X1,Y1,PHI1,ALAM1,2,EXM,EYM,EPH,EAL,
1888      &           IPA1PA2,IFIND2)
1889
1890             CALL CHECK_HISTO4(51,2,IPA1PA2,5,JJ5,X1,Y1,PHI1,ALAM1,
1891      &           P1,EXM,EYM,EPH,EAL)
1892             IF (IPA1PA2.GT.0) THEN
1893                JJ1 = IPA1
1894                JJ2 = IPA1PA2
1895                XMES(2) = XM(2,JJ2)
1896                YMES(2) = YM(2,JJ2)
1897                IZMES(2) = IZM(2,JJ2)
1898                PHMES(2) = PHM(2,JJ2)
1899                ALMES(2) = ALM(2,JJ2)
1900                MPOS(2) = 1
1901                MANG(2) = 1
1902                GOTO 123
1903             ELSE
1904                CALL DISTMIN2(X1,Y1,X2,Y2,2,EXM,EYM,0.D0,0.D0,IPA1P2,
1905      &              IFIND2)
1906                CALL CHECK_HISTO2(0,2,IPA1P2,5,JJ5,X1,Y1,X2,Y2,P1,
1907      &              EXM,EYM,0.D0,0.D0)
1908             ENDIF
1909          ENDIF
1910 *     -- Selection par type de candidat
1911          IF (IPA1PA2.EQ.0.OR.IPA2PA1.EQ.0) THEN
1912             IF (IPA2.GT.0.AND.IPA2P1.GT.0) THEN
1913                JJ2 = IPA2
1914                JJ1 = IPA2P1
1915                XMES(1) = XM(1,JJ1)
1916                YMES(1) = YM(1,JJ1)
1917                IZMES(1) = IZM(1,JJ1)
1918                MPOS(1) = 1
1919                MANG(1) = 0
1920                MPOS(2) = 1
1921                MANG(2) = 1
1922             ELSEIF(IPA1.GT.0.AND.IPA1P2.GT.0) THEN
1923                JJ1 = IPA1
1924                JJ2 = IPA1P2
1925                XMES(2) = XM(2,JJ2)
1926                YMES(2) = YM(2,JJ2)
1927                IZMES(2) = IZM(2,JJ2)
1928                MPOS(1) = 1
1929                MANG(1) = 1
1930                MPOS(2) = 1
1931                MANG(2) = 0
1932             ENDIF
1933          ENDIF
1934
1935  123     CONTINUE
1936 ***
1937          NTRACKFOLD = NTRACKF
1938          NMUONFOLD = NMUONF(1)+NMUONF(2)
1939          NGHOSTOLD = NGHOST
1940          CALL CHECK_MUON(JJ1,JJ2,JJ3,JJ4,JJ5,NTRACKF,NMUONF,
1941      &        NGHOST,NERR,PXZINV,TPHI,TALAM,XVERT,YVERT)
1942
1943          IF (NTRACKF.GT.NTRACKFOLD) THEN
1944             ISTAT(NTRACKF) = 0
1945             IF ((NMUONF(1)+NMUONF(2)).GT.NMUONFOLD) ISTAT(NTRACKF) = 1 ! Good muon
1946             IF (NGHOST.GT.NGHOSTOLD) ISTAT(NTRACKF) = 2 ! ghost track
1947             PXZOUT(NTRACKF) = 1./PXZINV
1948             TPHIOUT(NTRACKF) = TPHI
1949             TALAMOUT(NTRACKF) = TALAM
1950             XVERTOUT(NTRACKF) = XVERT
1951             YVERTOUT(NTRACKF) = YVERT
1952             PXVOUT(NTRACKF) = PVERT1(IP(5,JJ5))
1953             PYVOUT(NTRACKF) = PVERT2(IP(5,JJ5))
1954             PZVOUT(NTRACKF) = PVERT3(IP(5,JJ5))
1955             CHI2OUT(NTRACKF) = CHI2PL
1956          ENDIF
1957 ***
1958       ENDDO                     ! end loop on candidats NCAN
1959
1960  125  IF (NMU345(1).EQ.1.AND.NMU345(2).EQ.1) NRES(2) = NRES(2) + 1
1961
1962       IF (IDEBUG.GE.2) THEN
1963          PRINT *,'RECO_TRACKF nb of good muons 3 4 5 :'
1964      &        ,(NMU345(1)+NMU345(2))
1965
1966       ENDIF
1967
1968       IF (IDEBUG.GE.2) THEN
1969          PRINT *,'RECO_TRACKF nb of track/evt     :',NTRACKF
1970          PRINT *,'RECO_TRACKF nb of good muon/evt :',NMUONF(1)+NMUONF(2)
1971          PRINT *,'RECO_TRACKF nb of ghost/evt     :',NGHOST
1972          DO I = 1,4
1973             PRINT *,'RECO_TRACKF nb of error in st',I,'/evt:',NERR(I)
1974          ENDDO
1975       ENDIF
1976       IF (NTRMU.GE.2) NRES(5) = NRES(5)+1
1977       IF ((NMUONF(1)+NMUONF(2)).EQ.2) NRESF = NRESF+1
1978       NMUONALL = NMUONALL+NMUONF(1)+NMUONF(2)
1979       NGHOSTALL = NGHOSTALL+NGHOST
1980       NTRACKFALL = NTRACKFALL+NTRACKF
1981       DO I = 1,4
1982          NERRALL(I) = NERRALL(I)+NERR(I)
1983       ENDDO
1984
1985       CALL TRACKF_OUT(IR,NTRACKF)
1986 ***
1987       RETURN
1988       END
1989
1990 **********************************************************************
1991       SUBROUTINE TRACKF_OUT(IR,NTRACKF)
1992 **********************************************************************
1993 *
1994 *
1995 **********************************************************************
1996       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
1997
1998       PARAMETER (MAXHITCH=10000,MAXTRK=50000,MAXHITTOT=20000,
1999      &           NBSTATION=5)
2000       PARAMETER (NBCHAMBER=10,NTRMAX=500)
2001
2002       COMMON/RECOUT/JJO(NBCHAMBER,NTRMAX),XMESO(NBCHAMBER,NTRMAX),
2003      &              YMESO(NBCHAMBER,NTRMAX)
2004
2005       COMMON/TRACKFOUT/IEVOUT,NTREVT,JJOUT(NBCHAMBER,NTRMAX),
2006      &               ISTAT(NTRMAX),PXZOUT(NTRMAX),TPHIOUT(NTRMAX),
2007      &               TALAMOUT(NTRMAX),XVERTOUT(NTRMAX),YVERTOUT(NTRMAX),
2008      &               CHI2OUT(NTRMAX),
2009      &               XMESOUT(NBCHAMBER,NTRMAX),YMESOUT(NBCHAMBER,NTRMAX)
2010      &              ,PXVOUT(NTRMAX),PYVOUT(NTRMAX),PZVOUT(NTRMAX)
2011 **
2012       IEVOUT = IR
2013       NTREVT = NTRACKF
2014       IF (NTREVT.GT.0) THEN
2015          DO ITR = 1,NTREVT
2016             ICH = 0
2017             DO IST = 1,NBSTATION
2018                DO ILOOP = 1,2
2019                   ICH = ICH + 1
2020                   JJOUT(ICH,ITR) = JJO(ICH,ITR)
2021                   IF (JJOUT(ICH,ITR).GT.0) THEN
2022                       XMESOUT(ICH,ITR) = XMESO(ICH,ITR)
2023                       YMESOUT(ICH,ITR) = YMESO(ICH,ITR)
2024                   ENDIF
2025                ENDDO
2026             ENDDO
2027          ENDDO
2028       ENDIF
2029
2030
2031       RETURN
2032       END
2033 **********************************************************************
2034       SUBROUTINE CHECK_MUON(JJ1,JJ2,JJ3,JJ4,JJ5,
2035      &                  NTRACKF,NMUONF,NGHOST,NERR,PXZINV,TPHI,TALAM,
2036      &                  XVERT,YVERT)
2037 **********************************************************************
2038 *   Check muon track candidate using GEANT informations
2039 *
2040 **********************************************************************
2041       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2042 * --
2043       PARAMETER (MAXHITCH=10000,MAXTRK=50000,MAXHITTOT=20000,
2044      &           NBSTATION=5)
2045       PARAMETER (NBCHAMBER=10,NTRMAX=500)
2046
2047       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
2048      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
2049      &             IZM(NBSTATION,MAXHITCH),
2050      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
2051      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
2052
2053       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
2054      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
2055      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
2056      &            ZVERT(MAXHITTOT),NHITTOT
2057
2058       COMMON/VERIFGEANT/ITTROUGH(MAXTRK,NBSTATION),
2059      &                  IT_LIST(MAXTRK),IT_NP(MAXTRK),ITCHECK(MAXTRK),
2060      &                  ITRACK(MAXHITTOT)
2061
2062       COMMON/MEASUR/XMES(NBSTATION),YMES(NBSTATION),IZMES(NBSTATION),
2063      &              PHMES(NBSTATION),ALMES(NBSTATION),MPOS(NBSTATION),
2064      &              MANG(NBSTATION)
2065
2066       COMMON/RECOUT/JJO(NBCHAMBER,NTRMAX),XMESO(NBCHAMBER,NTRMAX),
2067      &              YMESO(NBCHAMBER,NTRMAX)
2068
2069       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
2070
2071       COMMON/MAGNET/BL3,B0
2072
2073       REAL*4 R1,R2
2074       DATA R1,R2/0.,1./
2075
2076       DIMENSION NERR(NBSTATION),JJK(NBSTATION),NMUONF(2)
2077
2078 *      print*,' *** appel de la subroutine check_muon ***'
2079
2080       IF (JJ1.GT.0.AND.JJ2.GT.0.AND.JJ3.GT.0.AND.JJ4.GT.0
2081      &     .AND.JJ5.GT.0) THEN
2082          IDFIND = ID(IP(5,JJ5))
2083          IT = ITRACK(IP(5,JJ5))
2084          JJK(1) = JJ1
2085          JJK(2) = JJ2
2086          JJK(3) = JJ3
2087          JJK(4) = JJ4
2088          JJK(5) = JJ5
2089          NTRACKF = NTRACKF+1
2090          DO I = 1,NBCHAMBER
2091             JJO(I,NTRACKF) = 0
2092          ENDDO
2093          ICH1 = -1
2094          DO IST = 1,5
2095             ICH1 = ICH1 + 2
2096             IF (XMR(IST,JJK(IST),1).LT.999.) THEN
2097                JJO(ICH1,NTRACKF) = JJK(IST)
2098                XMESO(ICH1,NTRACKF) = XMR(IST,JJK(IST),1)
2099                YMESO(ICH1,NTRACKF) = YMR(IST,JJK(IST),1)
2100                ICH2 = ICH1 + 1
2101                IF (MANG(IST).EQ.1) THEN
2102                   JJO(ICH2,NTRACKF) = JJK(IST)
2103                   XMESO(ICH2,NTRACKF) = XMR(IST,JJK(IST),2)
2104                   YMESO(ICH2,NTRACKF) = YMR(IST,JJK(IST),2)
2105                ENDIF
2106             ELSE
2107                ICH2 = ICH1+1
2108                JJO(ICH2,NTRACKF) = JJK(IST)
2109                XMESO(ICH2,NTRACKF) = XMR(IST,JJK(IST),2)
2110                YMESO(ICH2,NTRACKF) = YMR(IST,JJK(IST),2)
2111             ENDIF
2112          ENDDO
2113
2114          CALL CHFILL(700,SNGL(XVERT),R1,R2)
2115          CALL CHFILL(701,SNGL(YVERT),R1,R2)
2116
2117          IF (ITCHECK(IT).EQ.1) THEN
2118
2119
2120             IF (ID(IP(1,JJ1)).EQ.IDFIND .AND.
2121      &           ID(IP(2,JJ2)).EQ.IDFIND .AND.
2122      &           ID(IP(3,JJ3)).EQ.IDFIND .AND.
2123      &           ID(IP(4,JJ4)).EQ.IDFIND) THEN
2124
2125                IF (ITYP(IP(5,JJ5)).EQ.5) NMUONF(1) = 1 ! Bon muon
2126                IF (ITYP(IP(5,JJ5)).EQ.6) NMUONF(2) = 1 ! Bon muon
2127
2128                PT = SQRT(PVERT1(IP(5,JJ5))**2+PVERT2(IP(5,JJ5))**2)
2129                PZ =  PVERT3(IP(5,JJ5))
2130                E = SQRT(PT**2+PZ**2+0.1056**2)
2131                YRAP = 0.5*DLOG((E+PZ)/(E-PZ))
2132                PHIM = DATAN2(PVERT2(IP(5,JJ5)),PVERT1(IP(5,JJ5)))
2133                CALL CHFILL(801,SNGL(YRAP),R1,R2)
2134                CALL CHFILL(901,SNGL(PT),R1,R2)
2135                CALL CHFILL(911,SNGL(PHIM),R1,R2)
2136             ELSE
2137
2138                NGHOST = NGHOST+1 ! ghost
2139
2140                PT = SQRT(PVERT1(IP(5,JJ5))**2+PVERT2(IP(5,JJ5))**2)
2141                PZ =  PVERT3(IP(5,JJ5))
2142                E = SQRT(PT**2+PZ**2+0.1056**2)
2143                YRAP = 0.5*DLOG((E+PZ)/(E-PZ))
2144                PHIM = DATAN2(PVERT2(IP(5,JJ5)),PVERT1(IP(5,JJ5)))
2145                CALL CHFILL(802,SNGL(YRAP),R1,R2)
2146                CALL CHFILL(902,SNGL(PT),R1,R2)
2147                CALL CHFILL(912,SNGL(PHIM),R1,R2)
2148             ENDIF
2149          ENDIF
2150       ENDIF
2151       IF (ITCHECK(ITRACK(IP(5,JJ5))).EQ.1) THEN
2152          IF (JJ3.EQ.0) NERR(3) = NERR(3)+1
2153          IF (JJ3.NE.0) THEN
2154
2155             IF (JJ1.EQ.0) NERR(1) = NERR(1)+1
2156             IF (JJ2.EQ.0) NERR(2) = NERR(2)+1
2157             IF (JJ1.EQ.0) print*,'hit not found stations 1', NERR(1)
2158             IF (JJ2.EQ.0) print*,'hit not found stations 2', NERR(2)
2159
2160          ENDIF
2161          PT = SQRT(PVERT1(IP(5,JJ5))**2+PVERT2(IP(5,JJ5))**2)
2162          PZ =  PVERT3(IP(5,JJ5))
2163          E = SQRT(PT**2+PZ**2+0.1056**2)
2164          YRAP = 0.5*DLOG((E+PZ)/(E-PZ))
2165          PHIM = DATAN2(PVERT2(IP(5,JJ5)),PVERT1(IP(5,JJ5)))
2166          CALL CHFILL(800,SNGL(YRAP),R1,R2)
2167          CALL CHFILL(900,SNGL(PT),R1,R2)
2168          CALL CHFILL(910,SNGL(PHIM),R1,R2)
2169       ENDIF
2170
2171       RETURN
2172       END
2173
2174
2175 *************************************************************************
2176       SUBROUTINE RECO_SUM
2177 *************************************************************************
2178 *
2179 *
2180 *************************************************************************
2181       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2182 *
2183       PARAMETER (MAXHITCH=10000,MAXTRK=50000,MAXHITTOT=20000,
2184      &           NBSTATION=5)
2185       PARAMETER (NBCHAMBER=10,NTRMAX=500)
2186 *
2187       COMMON/TRACKFOUT/IEVOUT,NTREVT,JJOUT(NBCHAMBER,NTRMAX),
2188      &               ISTAT(NTRMAX),PXZOUT(NTRMAX),TPHIOUT(NTRMAX),
2189      &               TALAMOUT(NTRMAX),XVERTOUT(NTRMAX),YVERTOUT(NTRMAX),
2190      &               CHI2OUT(NTRMAX),
2191      &               XMESOUT(NBCHAMBER,NTRMAX),YMESOUT(NBCHAMBER,NTRMAX)
2192      &              ,PXVOUT(NTRMAX),PYVOUT(NTRMAX),PZVOUT(NTRMAX)
2193 *
2194       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
2195      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
2196      &             IZM(NBSTATION,MAXHITCH),
2197      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
2198      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
2199 *
2200       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
2201      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
2202      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
2203      &            ZVERT(MAXHITTOT),NHITTOT
2204 *
2205       COMMON/RECOUT/JJO(NBCHAMBER,NTRMAX),XMESO(NBCHAMBER,NTRMAX),
2206      &              YMESO(NBCHAMBER,NTRMAX)
2207 *
2208       COMMON/TRACKSUM/NRES(5),NRESF,NTRMUALL,NMUONALL,NGHOSTALL,
2209      &     NTRACKFALL,NERRALL(NBSTATION),IR
2210 *
2211       COMMON/PRECSUM/NRESF1,NMUONALL1,NGHOSTALL1,NTRACKFALL1
2212 *
2213       REAL*4 PXR,PYR,PZR,ZVR,CHI2R,PXV,PYV,PZV
2214       COMMON/PAWCR4/IEVR,NTRACKR,ISTATR(NTRMAX),ISIGNR(NTRMAX),
2215      &              PXR(NTRMAX),PYR(NTRMAX),PZR(NTRMAX),ZVR(NTRMAX),
2216      &              CHI2R(NTRMAX),PXV(NTRMAX),PYV(NTRMAX),PZV(NTRMAX)
2217 *
2218       COMMON/DEBEVT/IDEBUG
2219 *
2220       DIMENSION ISEL(NTRMAX)
2221
2222 *
2223       CALL RECO_SELECT(ISEL)
2224 *
2225       NMUF = 0
2226       NGHF = 0
2227
2228       DO ITR = 1,NTREVT
2229          IF (ISEL(ITR).EQ.1) THEN
2230             NTRACKFALL1 =  NTRACKFALL1 + 1
2231             IF (ISTAT(ITR).EQ.1) THEN
2232                NMUF = NMUF + 1
2233                NMUONALL1 = NMUONALL1 + 1
2234             ELSEIF (ISTAT(ITR).EQ.2) THEN
2235                NGHF = NGHF + 1
2236                NGHOSTALL1 = NGHOSTALL1 + 1
2237             ENDIF
2238          ENDIF
2239       ENDDO
2240
2241       IF (NMUF.GE.2) NRESF1 = NRESF1 + 1
2242 *
2243       NTRACKR = 0
2244       DO ITR = 1,NTREVT
2245          IF (ISEL(ITR).EQ.1) THEN
2246             NTRACKR = NTRACKR + 1
2247             ISTATR(NTRACKR) = ISTAT(ITR)
2248             ISIGNR(NTRACKR) = 1
2249             IF (PXZOUT(ITR).LT.0.) ISIGNR(NTRACKR) = -1
2250             PXZ = ABS(PXZOUT(ITR))
2251             PHI = ATAN(TPHIOUT(ITR))
2252             ALAM = ATAN(TALAMOUT(ITR))
2253             PYR(NTRACKR) = PXZ*SIN(PHI)
2254             PXR(NTRACKR) = PXZ*TAN(ALAM)
2255             PZR(NTRACKR) = PXZ*COS(PHI)
2256             ZVR(NTRACKR) = 0.
2257             CHI2R(NTRACKR) =  CHI2OUT(ITR)
2258             PXV(NTRACKR) = PXVOUT(ITR)
2259             PYV(NTRACKR) = PYVOUT(ITR)
2260             PZV(NTRACKR) = PZVOUT(ITR)
2261          ENDIF
2262       ENDDO
2263
2264       CALL CHFNT(IEVR,NTRACKR,ISTATR,ISIGNR,
2265      &     PXR,PYR,PZR,ZVR,CHI2R,PXV,PYV,PZV)
2266
2267       IF (IDEBUG.GE.2) THEN
2268          PRINT *,'RECO_SUM evt number :',IEVOUT
2269          PRINT *,'RECO_SUM nb of track /evt     :',NTRACKR
2270          PRINT *,'RECO_SUM nb of good muon /evt :',NMUF
2271          PRINT *,'RECO_SUM nb of ghost /evt     :',NGHF
2272          IF (NTRACKR.GT.0) THEN
2273             DO ITR = 1,NTRACKR
2274                PRINT *,'RECO_SUM track number :',ITR
2275                PRINT *,'RECO_SUM CHI2OUT :',CHI2R(ITR)
2276                PRINT *,' PX GEANT= ', PXV(ITR),' PX RECONS= ',PYR(ITR)
2277                PRINT *,' PY GEANT= ', PYV(ITR),' PY RECONS= ',PXR(ITR)
2278                PRINT *,' PZ GEANT= ', PZV(ITR),' PZ RECONS= ',PZR(ITR)
2279                PXZV = SQRT( PYV(ITR)**2+PZV(ITR)**2)
2280                PXZR = SQRT( PXR(ITR)**2+PZR(ITR)**2)
2281                PRINT *,' PXZ GEANT= ', PXZV,' PXZ RECONS= ',PXZR
2282                FIV=ATAN2(DBLE(PYV(ITR)),DBLE(PZV(ITR)))
2283                ALAMV=ATAN2(DBLE(PXV(ITR)),DBLE(PXZV))
2284                FIR=ATAN2(DBLE(PXR(ITR)),DBLE(PZR(ITR)))
2285                ALAMR=ATAN2(DBLE(PYR(ITR)),DBLE(PXZR))
2286 **               PRINT *,' PHI GEANT= ',FIV,' PXZ RECONS= ',FIR
2287 **               PRINT *,' ALAM GEANT= ',ALAMV,' ALAM RECONS= ',ALAMR
2288             ENDDO
2289          ENDIF
2290       ENDIF
2291
2292       RETURN
2293       END
2294
2295 *************************************************************************
2296       SUBROUTINE RECO_TERM
2297 *************************************************************************
2298 *
2299 *
2300 *************************************************************************
2301       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2302 *
2303       PARAMETER(NBSTATION=5)
2304 *
2305       COMMON/TRACKSUM/NRES(5),NRESF,NTRMUALL,NMUONALL,NGHOSTALL,
2306      &     NTRACKFALL,NERRALL(NBSTATION),IR
2307 *
2308       COMMON/PRECSUM/NRESF1,NMUONALL1,NGHOSTALL1,NTRACKFALL1
2309 *
2310       COMMON/DEBEVT/IDEBUG
2311 *
2312       CHARACTER*50 FILEBKG,FILERES,FILEOUT,FILEMIN
2313 *
2314       IF (IDEBUG.GE.1) THEN
2315          PRINT *,'    '
2316          PRINT *,'RECO_TERM ***** SUMMARY TRACK-FINDING *****'
2317          PRINT *,'RECO_TERM nb of resonances :',NRES(5)
2318          PRINT *,'RECO_TERM nb of resonances  45 :',NRES(1)
2319          PRINT *,'RECO_TERM nb of resonances 345 :',NRES(2)
2320          PRINT *,'RECO_TERM nb of resonances found :',NRESF
2321          PRINT *,'RECO_TERM nb of muon track       :',NTRMUALL
2322          PRINT *,'RECO_TERM nb of track found      :',NTRACKFALL
2323          PRINT *,'RECO_TERM nb of muon track found :',NMUONALL
2324          PRINT *,'RECO_TERM nb of ghost found      :',NGHOSTALL
2325          DO I = 1,4
2326             PRINT *,'RECO_TERM nb of error in st',I,':',NERRALL(I)
2327          ENDDO
2328
2329          PRINT *,'    '
2330          PRINT *,'RECO_TERM ***** SUMMARY PRECISION *****'
2331          PRINT *,'RECO_TERM nb of resonances found :',NRESF1
2332          PRINT *,'RECO_TERM nb of track found      :',NTRACKFALL1
2333          PRINT *,'RECO_TERM nb of muon track found :',NMUONALL1
2334          PRINT *,'RECO_TERM nb of ghost found      :',NGHOSTALL1
2335       ENDIF
2336 *
2337       CALL HIST_CLOSED
2338
2339       RETURN
2340       END
2341
2342 *************************************************************************
2343       SUBROUTINE RECO_PRECISION
2344 *************************************************************************
2345 *
2346 *
2347 *************************************************************************
2348       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2349 *
2350       PARAMETER (MAXHITCH=10000,MAXTRK=50000,MAXHITTOT=20000,
2351      &           NBSTATION=5,MAXCAN=1000,NTRMAX=500)
2352       PARAMETER (NPLANE=10)
2353 *
2354       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
2355      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
2356 *
2357       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
2358      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
2359      &             IZM(NBSTATION,MAXHITCH),
2360      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
2361      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
2362 *
2363       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
2364      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
2365      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
2366      &            ZVERT(MAXHITTOT),NHITTOT
2367 *
2368       COMMON/TRACKFOUT/IEVOUT,NTREVT,JJOUT(NPLANE,NTRMAX),
2369      &               ISTAT(NTRMAX),PXZOUT(NTRMAX),TPHIOUT(NTRMAX),
2370      &               TALAMOUT(NTRMAX),XVERTOUT(NTRMAX),YVERTOUT(NTRMAX),
2371      &               CHI2OUT(NTRMAX),
2372      &               XMESOUT(NPLANE,NTRMAX),YMESOUT(NPLANE,NTRMAX)
2373      &              ,PXVOUT(NTRMAX),PYVOUT(NTRMAX),PZVOUT(NTRMAX)
2374
2375 *
2376       COMMON/MEAS/LPLANE(NPLANE),XMP(NPLANE),YMP(NPLANE)
2377 *
2378       COMMON/FCNOUT/PXZEA,ALAMEA,PHIEA,XEA,YEA,NPLU,CHI2
2379 *
2380       COMMON/PRECCUT/PCUT,PTCUT,CHI2CUT
2381 *
2382       DIMENSION PARMU(MAXCAN,NPLANE,2),LPLANEMU(MAXCAN,NPLANE)
2383 *
2384       IF (NTREVT.EQ.0) RETURN
2385
2386       DO ITR = 1,NTREVT
2387          ICH = 0
2388          DO IST = 1,NBSTATION
2389             DO ILOOP = 1,2
2390                ICH = ICH + 1
2391 **               print *,' ich=',ich
2392                IF (JJOUT(ICH,ITR).GT.0) THEN
2393                   LPLANEMU(ITR,ICH) = 1
2394                   PARMU(ITR,ICH,1) = XMESOUT(ICH,ITR)
2395                   PARMU(ITR,ICH,2) = YMESOUT(ICH,ITR)
2396 **                  print *,' x,y ', PARMU(ITR,ICH,1),PARMU(ITR,ICH,2)
2397                ELSE
2398                   LPLANEMU(ITR,ICH) = 0
2399                ENDIF
2400             ENDDO
2401          ENDDO
2402       ENDDO
2403 *
2404       NTRACK = 0
2405       DO ICAN = 1,NTREVT
2406          DO ICH = 1,NPLANE
2407             LPLANE(ICH) = LPLANEMU(ICAN,ICH)
2408             XMP(ICH) = PARMU(ICAN,ICH,1)
2409             YMP(ICH) = PARMU(ICAN,ICH,2)
2410          ENDDO
2411
2412          IF (LPLANE(1).GT.0) THEN
2413             X1 = XMP(1)
2414             Y1 = YMP(1)
2415             IPL1 = 1
2416          ELSE
2417             X1 = XMP(2)
2418             Y1 = YMP(2)
2419             IPL1 = 2
2420          ENDIF
2421          IF (LPLANE(3).GT.0) THEN
2422             X2 = XMP(3)
2423             Y2 = YMP(3)
2424             IPL2 = 3
2425          ELSE
2426             X2 = XMP(4)
2427             Y2 = YMP(4)
2428             IPL2 = 4
2429          ENDIF
2430          IF (LPLANE(7).GT.0) THEN
2431             X3 = XMP(7)
2432             IPL3 = 7
2433          ELSE
2434             X3 = XMP(8)
2435             IPL3 = 8
2436          ENDIF
2437          IF (LPLANE(9).GT.0) THEN
2438             X4 = XMP(9)
2439             IPL4 = 9
2440          ELSE
2441             X4 = XMP(10)
2442             IPL4 = 10
2443          ENDIF
2444
2445          PHIAV = DATAN2((X2-X1),(ZPLANEP(IPL2)-ZPLANEP(IPL1)))
2446          PHIAP = DATAN2((X4-X3),(ZPLANEP(IPL4)-ZPLANEP(IPL3)))
2447          DPHI = (PHIAP-PHIAV)
2448          ASIGN = 1.
2449          IF (DPHI.LT.0.) ASIGN = -1. ! CCC
2450          PXZ = CONST/DABS(DPHI)
2451 ** Cuts PXZ
2452          IF (PXZ.LT.PCUT) GO TO 2
2453
2454          PXZINVI = ASIGN/PXZ ! CCC
2455 **         PXZINVI = 1./PXZOUT(ICAN) ! CCC
2456 **         PXZINVI = -1./49. ! CCC
2457          PHII = PHIAV
2458          ALAMI = DATAN2((Y2-Y1),DSQRT((X2-X1)**2
2459      &            +(ZPLANEP(IPL2)-ZPLANEP(IPL1))**2))
2460          XVR = X1
2461          YVR = Y1
2462 **         print *,' avant prec_fit pxzi phii alami x y',1./ PXZINVI,
2463 **     &         PHII, ALAMI ,XVR,YVR
2464 **         PRINT *,' X1 X2 X3 X4',X1,X2,X3,X4
2465 **         PRINT *,' Z1 Z2 Z3 Z4',ZPLANEP(IPL1),ZPLANEP(IPL2),
2466 **     &          ZPLANEP(IPL3),ZPLANEP(IPL4)
2467 **         PRINT *,' CONST= ',CONST
2468
2469
2470          IF (CHI2OUT(ICAN).GT.CHI2CUT) GO TO 2
2471
2472 ** Fit des traces apres l'absorbeur
2473          CALL PREC_FIT (PXZINVI,PHII,ALAMI,XVR,YVR,
2474      &          PXZINVF,PHIF,ALAMF,XVERTF,YVERTF,EPXZINV,EPHI,EALAM,
2475      &          EXVERT,EYVERT)
2476
2477 ** Correction de Branson
2478          CALL BRANSON(PXZEA,PHIEA,ALAMEA,XEA,YEA)
2479
2480          PXZ1 = DABS(PXZEA)
2481          PX1 = PXZ1*DSIN(PHIEA)
2482          PY1 = PXZ1*DTAN(ALAMEA)
2483          PT1 = DSQRT(PX1**2+PY1**2)
2484 ** Cuts PT
2485          IF (PT1.LT.PTCUT) GO TO 2
2486 ** Cuts CHI2
2487          IF ((CHI2/FLOAT(2*NPLU-5)).GT.CHI2CUT) GO TO 2
2488
2489          NTRACK = NTRACK + 1
2490          DO ICH = 1,NPLANE
2491             JJOUT(ICH,NTRACK) =  JJOUT(ICH,ICAN)
2492             XMESOUT(ICH,NTRACK) =  XMESOUT(ICH,ICAN)
2493             YMESOUT(ICH,NTRACK) =  YMESOUT(ICH,ICAN)
2494          ENDDO
2495          ISTAT(NTRACK) = ISTAT(ICAN)
2496          PXZOUT(NTRACK) = PXZEA
2497          TPHIOUT(NTRACK) = DTAN(PHIEA)
2498          TALAMOUT(NTRACK) = DTAN(ALAMEA)
2499          XVERTOUT(NTRACK) = XEA
2500          YVERTOUT(NTRACK) = YEA
2501          CHI2OUT(NTRACK) =  CHI2/FLOAT(2*NPLU-5)
2502
2503
2504 **         print *,' reco_precision pxz tphi talam xvert yvert chi2',
2505 **     &       PXZEA,PHIEA,ALAMEA,
2506 **     &       XEA,YEA,CHI2/FLOAT(2*NPLU-5)
2507   2      CONTINUE
2508       ENDDO
2509       NTREVT = NTRACK
2510
2511       RETURN
2512       END
2513
2514
2515 ************************************************************************
2516       SUBROUTINE ORDONNE_HIT(ICH,HCUT)
2517 **************************************************************************
2518 *
2519 *  Sort hits in station ICH according to the "impact parameter" HHIT
2520 *
2521 **************************************************************************
2522
2523       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2524
2525       PARAMETER (MAXHITCH=10000,MAXTRK=50000,MAXHITTOT=20000,
2526      &           NBSTATION=5)
2527
2528       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
2529      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
2530      &             IZM(NBSTATION,MAXHITCH),
2531      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
2532      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
2533
2534       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
2535
2536       COMMON/VERIFGEANT/ITTROUGH(MAXTRK,NBSTATION),
2537      &                  IT_LIST(MAXTRK),IT_NP(MAXTRK),ITCHECK(MAXTRK),
2538      &                  ITRACK(MAXHITTOT)
2539
2540       COMMON/HCHHIT/HHIT(MAXHITCH),INDEXTAB(MAXHITCH),INDEXMAX
2541 *
2542       COMMON/DEBEVT/IDEBUG
2543 *
2544       REAL*4 H4(MAXHITCH)
2545 * tri des impulsion par ordre decroissant
2546 * le tab INDEXTAB contient les j ordonnes
2547 * INDEXMAX est l indice max du tableau = NBHIT si pas de contrainte
2548
2549       JJ=0
2550       INDEXMAX = 0
2551 * boucle sur le nombre de hits candidats de la station
2552
2553       DO J=1,JHIT(ICH)
2554
2555           IF (PHM(ICH,J).LT.6.3) THEN        !2pi=6.3 radian
2556             JJ=JJ+1
2557 * calcul du h dans XOY a z=0
2558             HHIT(J)=ABS(XM(ICH,J)-ZPLANE(ICH)*PHM(ICH,J))
2559 * cut en Pxz
2560             IF (HHIT(J).LT.HCUT) THEN
2561                INDEXMAX=INDEXMAX+1
2562                INDEXTAB(INDEXMAX)=J
2563             ELSEIF(ITCHECK(ITRACK(IP(ICH,J))).EQ.1) THEN
2564                IF (IDEBUG.GE.2) THEN
2565                   PRINT *,'ORDONNE_HIT rejet muon/res in st.',ICH,
2566      &                 ' h=',HHIT(J)
2567                ENDIF
2568             ENDIF
2569          ENDIF
2570       ENDDO
2571
2572       NBHIT=JHIT(ICH)
2573
2574       DO I = 1,NBHIT
2575          H4(I) = SNGL(HHIT(I))
2576       ENDDO
2577
2578       CALL SORTZV(H4,INDEXTAB,INDEXMAX,-1,0,1)
2579
2580       DO I = 1,NBHIT
2581          HHIT(I) = DBLE(H4(I))
2582       ENDDO
2583 **      PRINT *,'ORDONNE st. numero',ICH
2584 **      PRINT *,'ORDONNE nb de hits initiaux dans st.',ICH,':',JHIT(ICH)
2585 **      PRINT *,'ORDONNE nb de hits avec mes. angulaire:',JJ
2586 **      PRINT *,'ORDONNE nb de hits avec mes. ang. et cut en Pxz:',INDEXMAX
2587       IF (IDEBUG.GE.2) THEN
2588          PRINT *,'ORDONNE_HIT nb de hits accepte dans st.',ICH,':',
2589      &           INDEXMAX
2590       ENDIF
2591
2592       RETURN
2593       END
2594 ***********************************************************************************
2595       SUBROUTINE DISTMIN4(X1,Y1,PHI1,ALAM1,ICH,EX,EY,EPHI,ELAM,IFIND,
2596      &     IFIND2)
2597 ***********************************************************************************
2598 *    Find the nearest hit in station ICH in the (X,Y,lambda,phi) phase space
2599 *
2600 ***********************************************************************************
2601
2602       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2603
2604       PARAMETER (MAXHITCH=10000,NBSTATION=5)
2605
2606       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
2607      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
2608      &             IZM(NBSTATION,MAXHITCH),
2609      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
2610      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
2611       DIMENSION IFIND2(10)
2612
2613       IFIND = 0
2614       DO I = 1,10
2615          IFIND2(I) = 0
2616       ENDDO
2617
2618       DISTMIN=4.
2619       NF = 0
2620       DO I=1,JHIT(ICH)
2621          IF (PHM(ICH,I).LE.6.3) THEN ! vector measurement
2622             IF (ABS(PHI1-PHM(ICH,I)) .LT. EPHI .AND.
2623      &         ABS(ALAM1-ALM(ICH,I)) .LT. ELAM .AND.
2624      &         ABS(X1-XM(ICH,I)) .LT. EX .AND.
2625      &         ABS(Y1-YM(ICH,I)) .LT. EY) THEN
2626                DIST = ((PHI1-PHM(ICH,I))/EPHI)**2 +
2627      &                ((ALAM1-ALM(ICH,I))/ELAM)**2 +
2628      &                ((X1-XM(ICH,I))/EX)**2 +
2629      &                ((Y1-YM(ICH,I))/EY)**2
2630                NF = NF+1
2631                IF (NF.LE.10) IFIND2(NF) = I
2632                IF (DIST .LT. DISTMIN) THEN
2633                   DISTMIN = DIST
2634                   IFIND = I
2635                ENDIF
2636             ENDIF
2637          ENDIF
2638       ENDDO
2639
2640       RETURN
2641       END
2642 ***********************************************************************************
2643       SUBROUTINE DISTMIN2(X1,Y1,X2,Y2,ICH,EX1,EY1,EX2,EY2,IFIND,IFIND2)
2644 ***********************************************************************************
2645 *    Find the nearest hit in station ICH in the (X,Y) space
2646 *
2647 ***********************************************************************************
2648       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2649
2650       PARAMETER (MAXHITCH=10000,NBSTATION=5)
2651
2652       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
2653      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
2654      &             IZM(NBSTATION,MAXHITCH),
2655      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
2656      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
2657       DIMENSION IFIND2(10)
2658
2659       IFIND = 0
2660       DO I = 1,10
2661          IFIND2(I) = 0
2662       ENDDO
2663
2664       DISTMIN=2.
2665       NF = 0
2666       DO I=1,JHIT(ICH)
2667          IF (IZM(ICH,I).EQ.1) THEN ! 1st chamber
2668             X = X1
2669             Y = Y1
2670          ELSE ! 2nd chamber
2671             X = X2
2672             Y = Y2
2673          ENDIF
2674          EX = EX1
2675          EY = EY1
2676          IF (ICH.EQ.4.OR.ICH.EQ.5) THEN
2677             IF (IZM(ICH,I).EQ.1) THEN
2678                EX = EX1
2679                EY = EY1
2680             ELSE
2681                EX = EX2
2682                EY = EY2
2683             ENDIF
2684          ENDIF
2685          IF (ABS(X-XM(ICH,I)) .LT. EX .AND.
2686      &      ABS(Y-YM(ICH,I)) .LT. EY) THEN
2687             DIST = ((X-XM(ICH,I))/EX)**2 +
2688      &             ((Y-YM(ICH,I))/EY)**2
2689             NF = NF+1
2690             IF (NF.LE.10) IFIND2(NF) = I
2691             IF (DIST .LT. DISTMIN) THEN
2692                DISTMIN = DIST
2693                IFIND = I
2694             ENDIF
2695          ENDIF
2696       ENDDO
2697
2698       RETURN
2699       END
2700 ********************************************************************************
2701       SUBROUTINE H_ACCEPTANCE(ICH)
2702 ********************************************************************************
2703 * Etude de l'acceptance des resonnances en  fonction du H
2704 * dans la station ICH
2705 *
2706 *  INPUT :    ICH
2707 *  OUTPUT :  Histo #1
2708 ********************************************************************************
2709
2710       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
2711
2712       PARAMETER (MAXHITCH=10000,MAXTRK=50000,MAXHITTOT=20000,
2713      &           NBSTATION=5)
2714
2715       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
2716      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
2717      &             IZM(NBSTATION,MAXHITCH),
2718      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
2719      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
2720
2721       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
2722      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
2723      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
2724      &            ZVERT(MAXHITTOT),NHITTOT
2725
2726
2727       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
2728
2729       COMMON/VERIFGEANT/ITTROUGH(MAXTRK,NBSTATION),
2730      &                  IT_LIST(MAXTRK),IT_NP(MAXTRK),ITCHECK(MAXTRK),
2731      &                  ITRACK(MAXHITTOT)
2732
2733       COMMON/HCHHIT/HHIT(MAXHITCH),INDEXTAB(MAXHITCH),INDEXMAX
2734
2735       REAL*4 R1,R2
2736       DATA R1,R2/0.,1./
2737
2738       NMUONI = 0
2739       DO J = 1,JHIT(ICH)
2740          IF (ITYP(IP(ICH,J)).EQ.5.OR.ITYP(IP(ICH,J)).EQ.6) THEN
2741             ISTAK = ID(IP(ICH,J))
2742             ISTAK = MOD(ISTAK,30000)
2743             ISTAK = MOD(ISTAK,10000)
2744             IF (ISTAK.EQ.0) THEN
2745 **              PRINT *,'ACCEPT. id du muon dans st.',ICH,':',ITYP(IP(ICH,J))
2746                NMUONI = NMUONI+1
2747             ENDIF
2748          ENDIF
2749       ENDDO
2750 *      PRINT *,'ACCEPT. nb de muons/res total dans st.',ICH,':',NMUONI
2751 *      pause
2752
2753       DO IH = 1,500
2754          HCUT = IH
2755 *   Sort hits in st. z
2756          CALL ORDONNE_HIT(ICH,HCUT)
2757          NMUON = 0
2758          DO IND = 1,INDEXMAX
2759             IIND = IP(ICH,INDEXTAB(IND))
2760             IDPART = ITYP(IIND)
2761             ISTAK = ID(IIND)
2762             ISTAK = MOD(ISTAK,30000)
2763             ISTAK = MOD(ISTAK,10000)
2764 **            PRINT *,' IDPART=',IDPART,' ISTAK=',ISTAK
2765             IF (IDPART.EQ.5.OR.IDPART.EQ.6.AND.ISTAK.EQ.0) THEN
2766                NMUON = NMUON+1
2767             ENDIF
2768          ENDDO
2769          IF (NMUON.EQ.2.AND.NMUONI.EQ.2) THEN
2770             CALL CHFILL(ICH*100,SNGL(HCUT),R1,R2)
2771          ENDIF
2772       ENDDO
2773
2774       RETURN
2775       END
2776
2777 ********************************************************************************
2778        SUBROUTINE OLDFOLLOW(ZSTR,PEST,IFLAG,XPL,YPL,PHPL,ALPL)
2779 ********************************************************************************
2780 *   Calculate the particle trajectory in the spectrometer and
2781 *   (XPL,YPL,PHPL,ALPL)
2782 *   for the 5 stations.
2783 *
2784 ********************************************************************************
2785        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2786 *
2787        PARAMETER(NBSTATION=5)
2788 *
2789        DIMENSION XPL(NBSTATION,2),YPL(NBSTATION,2),PHPL(NBSTATION),
2790      &           ALPL(NBSTATION),PEST(NBSTATION)
2791
2792        COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
2793
2794        COMMON /MEASUR/XMES(NBSTATION),YMES(NBSTATION),IZMES(NBSTATION),
2795      &                PHMES(NBSTATION),ALMES(NBSTATION),MPOS(NBSTATION),
2796      &                MANG(NBSTATION)
2797        COMMON /MAGNET/BL3,B0
2798
2799        LOGICAL LFLAG, LFLAG1
2800
2801        XSTR = PEST(4)
2802        YSTR = PEST(5)
2803        PXZINV = PEST(1)
2804        TPHI = PEST(2)
2805        PHI = ATAN(TPHI)
2806        TALAM = PEST(3)
2807        PXZ = 1.0/PXZINV
2808        PY = ABS(PXZ)*TALAM
2809        PX = -ABS(PXZ)*SIN(PHI)
2810        PZ = -ABS(PXZ)*COS(PHI)
2811        PXY = SQRT(PX**2 + PY**2)
2812        FI=ATAN2(DBLE(PY),DBLE(PX))
2813        SINFI = SIN(FI)
2814        COSFI = COS(FI)
2815        TTHET = PZ/PXY
2816        RS = PXY*(100.0/(0.299792458*BL3))
2817        IF(PXZINV.LT.0.0) RS = -RS
2818 *       XC = XSTR + RS*SIN(FI)
2819 *       YC = YSTR - RS*COS(FI)
2820        PX0 = PX
2821        PY0 = PY
2822        LFLAG = .TRUE.
2823        LFLAG1 = .TRUE.
2824 *       PRINT *, XC,YC,RS,FI,TTHET,PXY,PZ
2825
2826        DO J = 1,5
2827
2828           IF (IFLAG.EQ.3 .OR. MPOS(J).EQ.1) THEN
2829              IF(ZPLANE(J) .GT. ZCOIL) THEN
2830 *                DFI =  (ZPLANE(J)-ZSTR)/(TTHET*RS)
2831 *                FIN = FI - DFI
2832 *                XPL(J,1) = XC - RS*SIN(FIN)
2833 *                YPL(J,1) = YC + RS*COS(FIN)
2834                  DFR =  (ZPLANE(J)-ZSTR)/TTHET
2835                  XPL(J,1) = XSTR + DFR*COSFI + 0.5D0*DFR*DFR*SINFI/RS
2836                  YPL(J,1) = YSTR + DFR*SINFI - 0.5D0*DFR*DFR*COSFI/RS
2837                  DFR2 =  (ZPLANE(J)-DZ_PL(J)-ZSTR)/TTHET
2838                  XPL(J,2) = XSTR + DFR2*COSFI + 0.5D0*DFR2*DFR2*SINFI/RS
2839                  YPL(J,2) = YSTR + DFR2*SINFI - 0.5D0*DFR2*DFR2*COSFI/RS
2840                 IF (IFLAG.EQ.3 .OR. MANG(J).EQ.1) THEN
2841 *                   PX=PXY*COS(FIN)
2842 *                   PY=PXY*SIN(FIN)
2843                    PX = PX0 + DFR * (PY0 - 0.5D0*PX0*DFR/RS) / RS
2844                    PY = PY0 - DFR * (PX0 + 0.5D0*PY0*DFR/RS) / RS
2845                    PHPL(J)=ATAN(PX/PZ)
2846                    ALPL(J)=ATAN(PY/SQRT(PX**2+PZ**2))
2847                 ENDIF
2848               ELSE
2849                 IF( LFLAG) THEN
2850 *                   DFI =  (ZCOIL-ZSTR)/(TTHET*RS)
2851 *                   FIN = FI - DFI
2852 *                   XCOIL = XC - RS*SIN(FIN)
2853 *                   YCOIL = YC + RS*COS(FIN)
2854                    DFR =  (ZCOIL-ZSTR)/TTHET
2855                    XCOIL = XSTR + DFR*COSFI + 0.5D0*DFR*DFR*SINFI/RS
2856                    YCOIL = YSTR + DFR*SINFI - 0.5D0*DFR*DFR*COSFI/RS
2857 *                   PX=PXY*COS(FIN)
2858 *                   PY=PXY*SIN(FIN)
2859                    PX = PX0 + DFR * (PY0 - 0.5D0*PX0*DFR/RS) / RS
2860                    PY = PY0 - DFR * (PX0 + 0.5D0*PY0*DFR/RS) / RS
2861                    PXZ = SQRT(PX**2 + PZ**2)
2862                    PHI=ATAN(PX/PZ)
2863                    TALAM = PY/PXZ
2864                    ALAM = ATAN(TALAM)
2865                    RD = PXZ*(100.0/(0.299792458*B0))
2866                    IF(PXZINV.LT.0.0) RD = -RD
2867                    ZC = ZCOIL - RD*SIN(PHI)
2868                    XC = XCOIL + RD*COS(PHI)
2869                    IF(ABS(ZMAGEND-ZC).GT.ABS(RD)) STOP 'FOLLOW'
2870                    LFLAG = .FALSE.
2871                 ENDIF
2872                 IF(ZPLANE(J) .GT. ZMAGEND) THEN
2873                   FIN = ASIN((ZPLANE(J) - ZC)/RD)
2874                   XPL(J,1)= XC - RD*COS(FIN)
2875                   YPL(J,1)= YCOIL - RD*(FIN - PHI)*TALAM
2876                   FIN2 = ASIN((ZPLANE(J)-DZ_PL(J) - ZC)/RD)
2877                   XPL(J,2)= XC - RD*COS(FIN2)
2878                   YPL(J,2)= YCOIL - RD*(FIN2 - PHI)*TALAM
2879                   PHPL(J)=FIN
2880                   ALPL(J)=ALAM
2881                 ELSE
2882                   IF (LFLAG1) THEN
2883                     FIN = ASIN((ZMAGEND - ZC)/RD)
2884                     XMAGEND = XC - RD*COS(FIN)
2885                     YMAGEND = YCOIL - RD*(FIN - PHI)*TALAM
2886                     TPHI = TAN(FIN)
2887                     CPHI = COS(FIN)
2888                     LFLAG1 = .FALSE.
2889                   ENDIF
2890                   XPL(J,1) = XMAGEND + (ZPLANE(J)-ZMAGEND)*TPHI
2891                   YPL(J,1) = YMAGEND - (ZPLANE(J)-ZMAGEND)*TALAM/CPHI
2892                   XPL(J,2) = XMAGEND + (ZPLANE(J)-DZ_PL(J)-ZMAGEND)*TPHI
2893                   YPL(J,2) = YMAGEND - (ZPLANE(J)-DZ_PL(J)-ZMAGEND)*
2894      &                      TALAM/CPHI
2895                   PHPL(J)=FIN
2896                   ALPL(J)=ALAM
2897                 ENDIF
2898              ENDIF
2899           ENDIF
2900        ENDDO
2901        RETURN
2902        END
2903 ********************************************************************************
2904        SUBROUTINE FOLLOW(ZSTR,PEST,IFLAG,XPL,YPL,PHPL,ALPL)
2905 ********************************************************************************
2906 *   Calculate the particle trajectory in the spectrometer
2907 *   (XPL,YPL,PHPL,ALPL)
2908 *   for the 5 stations.
2909 *       Runge Kutta
2910 ********************************************************************************
2911        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2912 *
2913        PARAMETER(NBSTATION=5,NPLANE=10)
2914 *
2915        DIMENSION XPL(NBSTATION,2),YPL(NBSTATION,2),PHPL(NBSTATION),
2916      &           ALPL(NBSTATION),PEST(NBSTATION)
2917
2918        COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
2919
2920        COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
2921      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
2922
2923        COMMON /MEASUR/XMES(NBSTATION),YMES(NBSTATION),IZMES(NBSTATION),
2924      &                PHMES(NBSTATION),ALMES(NBSTATION),MPOS(NBSTATION),
2925      &                MANG(NBSTATION)
2926
2927
2928        DIMENSION VECT(7),VOUT(7)
2929
2930        STEP = 6.                ! 1 cm
2931        NSTEPMAX = 5000
2932
2933        ASIGN = 1.
2934        IF (PEST(1).LT.0.) ASIGN = -1.
2935        TPHI = -1.*PEST(2)
2936        PHI = DATAN(TPHI)
2937        TALAM = PEST(3)
2938        ALAM = DATAN(TALAM)
2939        PXZ = DABS(1./PEST(1))
2940
2941        PX = PXZ*DSIN(PHI)
2942        PY = PXZ*DTAN(ALAM)
2943        PZ = PXZ*DCOS(PHI)
2944        PTOT = PXZ/DCOS(ALAM)
2945
2946        VECT(1) = PEST(4)
2947        VECT(2) = PEST(5)
2948        VECT(3) = 0.
2949        VECT(4) = PX/PTOT
2950        VECT(5) = PY/PTOT
2951        VECT(6) = PZ/PTOT
2952        VECT(7) = PTOT
2953
2954        Z = VECT(3)
2955        NSTEP = 0
2956 *
2957 ** Runge Kutta
2958 **      PRINT *,' AV GRKUTA ASIGN',ASIGN,' THET',THET
2959        ISTOLD = 0
2960        DO ICH = 1,NPLANE
2961
2962           IST = INT(FLOAT(ICH+1)/2.)
2963
2964
2965           DO WHILE (Z.GE.0..AND.Z.LT.ABS(ZPLANEP(ICH))
2966      &         .AND.NSTEP.LE.NSTEPMAX)
2967              NSTEP = NSTEP+1
2968 **          WRITE(6,*) NSTEP,(VECT(I),I=1,7)
2969 **             CALL RECO_GRKUTA (ASIGN,STEP,VECT,VOUT) ! CCC
2970              CALL RECO_GHELIX (ASIGN,STEP,VECT,VOUT)
2971              DO I = 1,7
2972                 VECT(I) = VOUT(I)
2973              ENDDO
2974              Z = VECT(3)
2975           ENDDO
2976           IF (IST.NE.ISTOLD) THEN
2977              IPCH = 1
2978           ELSE
2979              IPCH = 2
2980           ENDIF
2981           XPL(IST,IPCH) = VECT(1)-(Z-ABS(ZPLANEP(ICH)))*VECT(4)/VECT(6)
2982           YPL(IST,IPCH) = VECT(2)-(Z-ABS(ZPLANEP(ICH)))*VECT(5)/VECT(6)
2983           IF (IPCH.EQ.2) THEN
2984              DX = XPL(IST,2)-XPL(IST,1)
2985              DY = YPL(IST,2)-YPL(IST,1)
2986              PHPL(IST) = -1.*DATAN2(DX,DZ_PL(IST))
2987              ALPL(IST) = DATAN2(DY,DSQRT(DX**2+DZ_PL(IST)**2))
2988           ENDIF
2989           ISTOLD = IST
2990        ENDDO
2991 **          print *,' vect= ',vect(1),vect(2),vect(3),vect(4),vect(5),
2992 **     &        vect(6),vect(7)
2993
2994
2995        RETURN
2996        END
2997 *******************************************************************************
2998        SUBROUTINE FCN(NPAR,GRAD,FVAL,PEST,IFLAG,FUTIL)
2999 *******************************************************************************
3000 *   Calculate FVAL=CHI2 the function minimized by minuit for a given track
3001 *
3002 *******************************************************************************
3003        IMPLICIT DOUBLE PRECISION(A-H,O-Z)
3004
3005        PARAMETER(NBSTATION=5)
3006
3007 *       DIMENSION PEST(*),GRAD(*)
3008        DIMENSION PEST(5),GRAD(5)
3009        DIMENSION PEEST(NBSTATION)
3010
3011        COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
3012
3013
3014        COMMON/PRECIS/EEXM(NBSTATION),EEYM(NBSTATION),EEPH(NBSTATION),
3015      &     EEAL(NBSTATION)
3016
3017        COMMON /MEASUR/XMES(NBSTATION),YMES(NBSTATION),IZMES(NBSTATION),
3018      &               PHMES(NBSTATION),ALMES(NBSTATION), MPOS(NBSTATION),
3019      &               MANG(NBSTATION)
3020
3021        COMMON /PLANE/XPL(NBSTATION,2),YPL(NBSTATION,2),PHPL(NBSTATION),
3022      &               ALPL(NBSTATION),CHI2PL
3023
3024        COMMON/VERTEX/ERRV,IVERTEX
3025
3026        DIMENSION XC(NBSTATION),YC(NBSTATION)
3027
3028        EXTERNAL RECOCHI2
3029
3030        PEEST(1)=PEST(1)
3031        PEEST(2)=PEST(2)
3032        PEEST(3)=PEST(3)
3033        IF(IVERTEX.EQ.1) THEN
3034           PEEST(4)=PEST(4)      ! position du vertex
3035           PEEST(5)=PEST(5)
3036        ELSE
3037           PEEST(4)=0.0D0
3038           PEEST(5)=0.0D0
3039        ENDIF
3040
3041        ALAM = DATAN(PEST(3))
3042        PXZ = DABS(1./PEST(1))
3043        PTOT = PXZ/DCOS(ALAM)
3044
3045
3046        CALL FOLLOW (0.0D0,PEEST,IFLAG,XPL,YPL,PHPL,ALPL) ! calcul des
3047        IF(IFLAG.EQ.1) THEN                       ! points d impacts dans les
3048           PRINT *,'FCN ',XPL(4,1),XMES(4)        ! plans
3049           PRINT *,'FCN ',YPL(4,1),YMES(4)
3050           PRINT *,'FCN ',XPL(5,1),XMES(5)
3051           PRINT *,'FCN ',YPL(5,1),YMES(5)
3052        ENDIF
3053
3054        DO I = 1,NBSTATION
3055           XC(I) = XPL(I,1)
3056           YC(I) = YPL(I,1)
3057        ENDDO
3058
3059        IF (IVERTEX.EQ.1) THEN
3060
3061           FVAL = RECOCHI2(MPOS,MANG,XMES,YMES,ALMES,PHMES,
3062      &     XC,YC,ALPL,PHPL,PTOT,IZMES,NPLPL)
3063
3064        ELSE
3065
3066           FVAL = 0.0D0
3067
3068           NPLPL = 0
3069           DO J = 1,NBSTATION
3070              IF (MPOS(J).EQ.1) THEN
3071                 NPLPL = NPLPL+1
3072                 XPLC = XPL(J,IZMES(J))
3073                 YPLC = YPL(J,IZMES(J))
3074                 FF = (XMES(J) - XPLC)/EEXM(J)
3075                 FVAL = FVAL + FF**2
3076                 FF = (YMES(J) - YPLC)/EEYM(J)
3077                 FVAL = FVAL + FF**2
3078              ENDIF
3079              IF (MANG(J).EQ.1) THEN
3080                 NPLPL = NPLPL+1
3081                 FF = (PHMES(J) - PHPL(J))/EEPH(J)
3082                 FVAL = FVAL + FF**2
3083                 FF = (ALMES(J) - ALPL(J))/EEAL(J)
3084                 FVAL = FVAL + FF**2
3085              ENDIF
3086           ENDDO
3087
3088        ENDIF
3089
3090        NPARAM = 3
3091        IF (IVERTEX.EQ.1) NPARAM = 5
3092        CHI2PL = FVAL/FLOAT(2*NPLPL-NPARAM)
3093
3094        RETURN
3095        END
3096 ********************************************************************************
3097       SUBROUTINE STOCK_CANDIDAT(ICH1,JHITCH1,ICH2,IFIND,IFIND2,EXM,EYM,
3098      &     EPH,EAL,NCAN,ICODE)
3099 ********************************************************************************
3100 *   Fill common CANDIDAT with track candidates from the search in stations 4&5
3101 *
3102 ********************************************************************************
3103
3104       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
3105
3106       PARAMETER (MAXHITTOT=20000,MAXHITCH=10000,NBSTATION=5,MAXCAN=1000)
3107
3108       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
3109      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
3110      &             IZM(NBSTATION,MAXHITCH),
3111      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
3112      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
3113
3114       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
3115      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
3116      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
3117      &            ZVERT(MAXHITTOT),NHITTOT
3118
3119
3120       COMMON/CANDIDAT/JCAN(NBSTATION,MAXCAN),JCANTYP(MAXCAN),
3121      &          EEX(MAXCAN),EEY(MAXCAN),EEP(MAXCAN),EEA(MAXCAN)
3122       DIMENSION IFIND2(10)
3123
3124 **      PRINT *,'STOCK st. init.=',ICH1,'id. init.=',ID(IP(ICH1,JHITCH1))
3125 **      PRINT *,'STOCK st. finale=',ICH2,'id. final=',ID(IP(ICH2,IFIND))
3126 **      PRINT *,'STOCK ifind=',IFIND
3127 **      PRINT *,'STOCK icode=',ICODE
3128
3129       DO I = 1,10
3130          IF (IFIND2(I).GT.0) THEN
3131             NCAN = NCAN+1
3132             JCAN(ICH1,NCAN) = JHITCH1
3133             JCAN(ICH2,NCAN) = IFIND2(I)
3134             JCANTYP(NCAN) = ICODE
3135             EEX(NCAN) = EXM
3136             EEY(NCAN) = EYM
3137             EEP(NCAN) = EPH
3138             EEA(NCAN) = EAL
3139          ENDIF
3140       ENDDO
3141
3142       RETURN
3143       END
3144 *******************************************************************************
3145        SUBROUTINE FCNOLD(NPAR,GRAD,FVAL,PEST,IFLAG,FUTIL)
3146 *******************************************************************************
3147 *   Calculate FVAL=CHI2 the function minimized by minuit for a given track
3148 *
3149 *******************************************************************************
3150        IMPLICIT DOUBLE PRECISION(A-H,O-Z)
3151
3152        PARAMETER(NBSTATION=5)
3153
3154 *       DIMENSION PEST(*),GRAD(*)
3155        DIMENSION PEST(5),GRAD(5)
3156        DIMENSION PEEST(NBSTATION)
3157
3158        COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
3159
3160
3161        COMMON/PRECIS/EEXM(NBSTATION),EEYM(NBSTATION),EEPH(NBSTATION),
3162      &     EEAL(NBSTATION)
3163
3164        COMMON /MEASUR/XMES(NBSTATION),YMES(NBSTATION),IZMES(NBSTATION),
3165      &               PHMES(NBSTATION),ALMES(NBSTATION), MPOS(NBSTATION),
3166      &               MANG(NBSTATION)
3167
3168        COMMON /PLANE/XPL(NBSTATION,2),YPL(NBSTATION,2),PHPL(NBSTATION),
3169      &               ALPL(NBSTATION),CHI2PL
3170
3171        COMMON/VERTEX/ERRV,IVERTEX
3172
3173        PEEST(1)=PEST(1)
3174        PEEST(2)=PEST(2)
3175        PEEST(3)=PEST(3)
3176        IF(IVERTEX.EQ.1) THEN
3177           PEEST(4)=PEST(4)      ! position du vertex
3178           PEEST(5)=PEST(5)
3179        ELSE
3180           PEEST(4)=0.0D0
3181           PEEST(5)=0.0D0
3182        ENDIF
3183
3184        CALL FOLLOW (0.0D0,PEEST,IFLAG,XPL,YPL,PHPL,ALPL) ! calcul des
3185        IF(IFLAG.EQ.1) THEN                       ! points d impacts dans les
3186           PRINT *,'FCN ',XPL(4,1),XMES(4)        ! plans
3187           PRINT *,'FCN ',YPL(4,1),YMES(4)
3188           PRINT *,'FCN ',XPL(5,1),XMES(5)
3189           PRINT *,'FCN ',YPL(5,1),YMES(5)
3190        ENDIF
3191
3192 *       IF (IVERTEX.EQ.1) THEN
3193 *          FVAL = (PEST(4)/ERRV)**2 + (PEST(5)/ERRV)**2
3194 *       ELSE
3195           FVAL = 0.0D0
3196 *       ENDIF
3197        NPLPL = 0
3198        DO J = 1,NBSTATION
3199           IF (MPOS(J).EQ.1) THEN
3200              NPLPL = NPLPL+1
3201              XPLC = XPL(J,IZMES(J))
3202              YPLC = YPL(J,IZMES(J))
3203              FF = (XMES(J) - XPLC)/EEXM(J)
3204              FVAL =FVAL + FF**2
3205              FF = (YMES(J) - YPLC)/EEYM(J)
3206              FVAL =FVAL + FF**2
3207           ENDIF
3208           IF (MANG(J).EQ.1) THEN
3209              NPLPL = NPLPL+1
3210              FF = (PHMES(J) - PHPL(J))/EEPH(J)
3211              FVAL =FVAL + FF**2
3212              FF = (ALMES(J) - ALPL(J))/EEAL(J)
3213              FVAL =FVAL + FF**2
3214           ENDIF
3215        ENDDO
3216 **       PRINT *,'ST 1',XPL(1,1),XMES(1),YPL(1,1),YMES(1)
3217 **       PRINT *,'ST 2',XPL(2,1),XMES(2),YPL(2,1),YMES(2)
3218 **       PRINT *,'ST 3',XPL(3,1),XMES(3),YPL(3,1),YMES(3)
3219 **       PRINT *,'ST 4',XPL(4,1),XMES(4),YPL(4,1),YMES(4)
3220 **       PRINT *,'ST 5',XPL(5,1),XMES(5),YPL(5,1),YMES(5)
3221        NPARAM = 3
3222        IF (IVERTEX.EQ.1) NPARAM = 5
3223        CHI2PL = FVAL/FLOAT(2*NPLPL-NPARAM)
3224
3225        RETURN
3226        END
3227 ****************************************************************************
3228       SUBROUTINE CHECK_HISTO4(IDHIST,ICH2,IHIT2,ICH1,IHIT1,
3229      &                        X1,Y1,PHI1,ALAM1,P1,EXM,EYM,EPH,EAL)
3230 *****************************************************************************
3231 *   Check hit IHIT2 with GEANT informations from hit HIT1
3232 *
3233 *    INPUT : ICH2 : No st. de recherche
3234 *            IDCH1,X1,Y1,PHI1,ALAM1,P1 : Trace de reference
3235 *    OUTPUT : JOK : No hit dans ICH2 appartenant a la meme trace.
3236 *
3237 *****************************************************************************
3238       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
3239
3240       PARAMETER (MAXHITCH=10000,MAXHITTOT=20000,NBSTATION=5,
3241      &           MAXTRK=50000)
3242
3243       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
3244      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
3245      &             IZM(NBSTATION,MAXHITCH),
3246      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
3247      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
3248
3249       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
3250      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
3251      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
3252      &            ZVERT(MAXHITTOT),NHITTOT
3253
3254       COMMON/VERIFGEANT/ITTROUGH(MAXTRK,NBSTATION),
3255      &                  IT_LIST(MAXTRK),IT_NP(MAXTRK),ITCHECK(MAXTRK),
3256      &                  ITRACK(MAXHITTOT)
3257 *
3258       COMMON/DEBEVT/IDEBUG
3259
3260       REAL*4 R2
3261       DATA R2/1./
3262
3263       JOK = 0
3264
3265       DO I=1,JHIT(ICH2)
3266          IF (PHM(ICH2,I).LE.6.3) THEN ! vector measurement
3267             IF (ID(IP(ICH1,IHIT1)).EQ.ID(IP(ICH2,I))) THEN
3268                JOK = I
3269                IF (IDHIST.GT.0) THEN
3270 *                  CALL CHF1(IDHIST,SNGL(P1),SNGL((X1-XM(ICH2,I))**2))
3271 *                  CALL CHF1(IDHIST+1,SNGL(P1),SNGL((Y1-YM(ICH2,I))**2))
3272 *                  CALL CHF1(IDHIST+2,SNGL(P1),
3273 *     &                     SNGL((PHI1-PHM(ICH2,I))**2))
3274 *                  CALL CHF1(IDHIST+3,SNGL(P1),
3275 *     &                     SNGL((ALAM1-ALM(ICH2,I))**2))
3276 *                  CALL CHF1(IDHIST+4,SNGL(P1),R2)
3277                ENDIF
3278             ENDIF
3279          ENDIF
3280       ENDDO
3281
3282       IF (JOK.GT.0) THEN
3283          IF (ITCHECK(ITRACK(IP(ICH1,IHIT1))).EQ.1) THEN
3284             IF (IDEBUG.GE.2) THEN
3285                IF (IHIT2.EQ.0) THEN
3286                   PRINT *,'CHECK4 histo nb:',IDHIST
3287                   PRINT *,'CHECK4 p de st.',ICH1,'=',P1
3288                   PRINT *,'CHECK4 track not found in st.',ICH2
3289                   PRINT *,'CHECK4 error X :',(XM(ICH2,JOK)-X1), EXM
3290                   PRINT *,'CHECK4 error Y :',(YM(ICH2,JOK)-Y1), EYM
3291                   PRINT *,'CHECK4 error PHI :',(PHM(ICH2,JOK)-PHI1),EPH
3292                   PRINT *,'CHECK4 error ALAM :',(ALM(ICH2,JOK)-ALAM1),
3293      &                     EAL
3294                ELSEIF (IHIT2.NE.JOK) THEN
3295                   PRINT *,'CHECK4 histo nb:',IDHIST
3296                   PRINT *,'CHECK4 p de st.',ICH1,'=',P1
3297                   PRINT *,'CHECK4 ghost in st.',ICH2
3298                   PRINT *,'CHECK4 id part. recherchee:',
3299      &                    ID(IP(ICH1,IHIT1))
3300                   PRINT *,'CHECK4 id ghost trouve    :',
3301      &                    ID(IP(ICH2,IHIT2))
3302                   PRINT *,'CHECK4 JOK=',JOK,' IHIT2=',IHIT2
3303                ENDIF
3304             ENDIF
3305          ENDIF
3306       ENDIF
3307
3308       RETURN
3309       END
3310 *****************************************************************************
3311       SUBROUTINE CHECK_HISTO2(IDHIST,ICH2,IHIT2,ICH1,IHIT1,
3312      &                        X1,Y1,X2,Y2,P1,EX1,EY1,EX2,EY2)
3313 *****************************************************************************
3314 *   Check hit IHIT2 with GEANT informations from hit HIT1
3315 *
3316 *    INPUT : IDHIST : No histo
3317 *            ICH2 : No st. de recherche
3318 *            IDCH1,X1,Y1,PHI1,ALAM1,P1 : Trace de reference
3319 *    OUTPUT : JOK : No hit dans ICH2 appartenant a la meme trace.
3320 *
3321 *****************************************************************************
3322       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
3323
3324       PARAMETER (MAXHITCH=10000,MAXHITTOT=20000,NBSTATION=5,
3325      &           MAXTRK=50000)
3326
3327       COMMON/CHHIT/XM(NBSTATION,MAXHITCH),YM(NBSTATION,MAXHITCH),
3328      &             PHM(NBSTATION,MAXHITCH),ALM(NBSTATION,MAXHITCH),
3329      &             IZM(NBSTATION,MAXHITCH),
3330      &             IP(NBSTATION,MAXHITCH),JHIT(NBSTATION),
3331      &             XMR(NBSTATION,MAXHITCH,2),YMR(NBSTATION,MAXHITCH,2)
3332
3333       COMMON/RHIT/ITYP(MAXHITTOT),XTR(MAXHITTOT),YTR(MAXHITTOT),
3334      &            PTOT(MAXHITTOT),ID(MAXHITTOT),IZST(MAXHITTOT),
3335      &            PVERT1(MAXHITTOT),PVERT2(MAXHITTOT),PVERT3(MAXHITTOT),
3336      &            ZVERT(MAXHITTOT),NHITTOT
3337
3338       COMMON/VERIFGEANT/ITTROUGH(MAXTRK,NBSTATION),
3339      &                  IT_LIST(MAXTRK),IT_NP(MAXTRK),ITCHECK(MAXTRK),
3340      &                  ITRACK(MAXHITTOT)
3341 *
3342       COMMON/DEBEVT/IDEBUG
3343
3344       REAL*4 R2
3345       DATA R2/1./
3346
3347       JOK = 0
3348
3349       DO I=1,JHIT(ICH2)
3350          IF (ID(IP(ICH1,IHIT1)).EQ.ID(IP(ICH2,I))) THEN
3351             JOK = I
3352             IF (IDHIST.GT.0) THEN
3353                IF (IZM(ICH2,I).EQ.1) THEN ! 1st chamber
3354                   X = X1
3355                   Y = Y1
3356                ELSE  ! 2nd chamber
3357                   X = X2
3358                   Y = Y2
3359                ENDIF
3360                CALL CHF1(IDHIST,SNGL(P1),SNGL((X-XM(ICH2,I))**2))
3361                CALL CHF1(IDHIST+1,SNGL(P1),SNGL((Y-YM(ICH2,I))**2))
3362                CALL CHF1(IDHIST+4,SNGL(P1),R2)
3363             ENDIF
3364          ENDIF
3365       ENDDO
3366
3367       IF (JOK.GT.0) THEN
3368          IF (ITCHECK(ITRACK(IP(ICH1,IHIT1))).EQ.1) THEN
3369             EXM = EX1
3370             EYM = EY1
3371             IF (IZM(ICH2,JOK).EQ.1) THEN
3372                X = X1
3373                Y = Y1
3374                IF (ICH2.EQ.4.OR.ICH2.EQ.5) THEN
3375                   EXM = EX1
3376                   EYM = EY1
3377                ENDIF
3378             ELSE
3379                X = X2
3380                Y = Y2
3381                IF (ICH2.EQ.4.OR.ICH2.EQ.5) THEN
3382                   EXM = EX2
3383                   EYM = EY2
3384                ENDIF
3385             ENDIF
3386             IF (IDEBUG.GE.2) THEN
3387                IF (IHIT2.EQ.0) THEN
3388                   PRINT *,'CHECK2 histo nb:',IDHIST
3389                   PRINT *,'CHECK2 p de st.',ICH1,'=',P1
3390                   PRINT *,'CHECK2 track not found in st.',ICH2
3391                   PRINT *,'CHECK2 error X :',(XM(ICH2,JOK)-X), EXM
3392                   PRINT *,'CHECK2 error Y :',(YM(ICH2,JOK)-Y), EYM
3393                ELSEIF(IHIT2.NE.JOK) THEN
3394                   PRINT *,'CHECK2 histo nb:',IDHIST
3395                   PRINT *,'CHECK2 p de st.',ICH1,'=',P1
3396                   PRINT *,'CHECK2 ghost in st.',ICH2
3397                   PRINT *,'CHECK2 id part. recherchee:',
3398      &                    ID(IP(ICH1,IHIT1))
3399                   PRINT *,'CHECK2 id ghost trouve    :',
3400      &                    ID(IP(ICH2,IHIT2))
3401                   PRINT *,'CHECK2 JOK=',JOK,' IHIT2=',IHIT2
3402                ENDIF
3403             ENDIF
3404          ENDIF
3405       ENDIF
3406
3407       RETURN
3408       END
3409
3410       DOUBLE PRECISION FUNCTION DEDX(P,THET,XEA,YEA)
3411       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3412       REA = DSQRT(XEA**2+YEA**2)
3413       IF (REA.lT.26.3611) THEN
3414          if (p .lt. 15.) then
3415             DP=2.737+0.0494*p-0.001123*p*p
3416          else
3417             DP=3.0643+0.01346*p
3418          endif
3419       ELSE
3420          if (p .lt. 15.) then
3421             DP = 2.1380+0.0351*p-0.000853*p*p
3422          else
3423             DP = 2.407+0.00702*p
3424          endif
3425       ENDIF
3426       P=P+DP/DCOS(THET)
3427       DEDX=P
3428       RETURN
3429       END
3430
3431 ************************************************************************
3432       DOUBLE PRECISION FUNCTION DEDX_oldold(P,THET,XEA,YEA)
3433 ************************************************************************
3434 *    DEDX est la nouvelle impulsion au vertex, corrigee de la perte
3435 *    d'energie dans l'absorbeur
3436 *
3437 ************************************************************************
3438
3439       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3440       DIMENSION PPB(6), PW(6)
3441 *   FIT RESULT FOR PB REGION (5TH ORDER POLY)
3442 *   1  p0           2.24358e+03   2.55765e+00   1.06982e-03   6.30474e-07
3443 *   2  p1           1.16393e+01   4.45081e-02   6.58627e-06  -1.15822e-04
3444 *   3  p2          -1.82314e-01   3.28429e-04   8.69340e-08  -1.27281e-02
3445 *   4  p3           1.60930e-03   2.23812e-06   7.67374e-10  -4.15573e-01
3446 *   5  p4          -6.96885e-06   1.35405e-08   3.32301e-12   1.22136e+02
3447 *   6  p5           1.16339e-08   5.91665e-11   1.06532e-14   3.33965e+04
3448
3449       DATA PPB /2.24358d+03, 1.16393d+01, -1.82314d-01, 1.60930d-03
3450      +         ,-6.96885d-06, 1.16339d-08/
3451 *   FIT RESULT FOR W REGION (5TH ORDER POLY)
3452 *   1  p0           2.90155e+03   3.49066e+00   1.38357e-03  -2.79916e-05
3453 *   2  p1           1.57716e+01   6.09946e-02   9.03687e-06  -6.63098e-03
3454 *   3  p2          -2.48349e-01   4.50365e-04   1.18422e-07  -8.27199e-01
3455 *   4  p3           2.19908e-03   3.07148e-06   1.04860e-09  -1.03290e+02
3456 *   5  p4          -9.54046e-06   1.85908e-08   4.54924e-12  -1.51284e+04
3457 *   6  p5           1.59463e-08   8.11346e-11   1.46446e-14  -2.69491e+06
3458       DATA PW /2.90155d+03, 1.57716d+01, -2.48349d-01, 2.19908d-03
3459      +         , -9.54046d-06, 1.59463d-08/
3460 *
3461       REA = DSQRT(XEA**2+YEA**2)
3462       IF (REA.GT.26.3611) THEN
3463          DP=PPB(1)+PPB(2)*P+PPB(3)*P**2
3464      &    +PPB(4)*P**3+PPB(5)*P**4+PPB(6)*P**5
3465       ELSE
3466          DP=PW(1)+PW(2)*P+PW(3)*P**2
3467      &    +PW(4)*P**3+PW(5)*P**4+PW(6)*P**5
3468       ENDIF
3469       P=P+DP/1000.D0/DCOS(THET)
3470       DEDX=P
3471       RETURN
3472       END
3473 ************************************************************************
3474       DOUBLE PRECISION FUNCTION DEDX_OLD(P,THET,XEA,YEA)
3475 ************************************************************************
3476 *    DEDX est la nouvelle impulsion au vertex, corrigee de la perte
3477 *    d'energie dans l'absorbeur
3478 *
3479 ************************************************************************
3480
3481       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3482
3483       REA = DSQRT(XEA**2+YEA**2)
3484       IF (REA.GT.26.3611) THEN
3485 *   Plomb
3486          SPB = 5./DCOS(THET)
3487          P = P+SPB/1000.*11.35*(16.66D-3 * P+1.33)
3488 *   Polyethylene
3489          SPO = 5./DCOS(THET)
3490          P = P+SPO/1000.*0.935*(2.22D-3 * P+2.17)
3491 *   Plomb
3492          SPB = 5./DCOS(THET)
3493          P = P+SPB/1000.*11.35*(16.66D-3 * P+1.33)
3494 *   Polyethylene
3495          SPO = 5./DCOS(THET)
3496          P = P+SPO/1000.*0.935*(2.22D-3 * P+2.17)
3497 *   Plomb
3498          SPB = 5./DCOS(THET)
3499          P = P+SPB/1000.*11.35*(16.66D-3 * P+1.33)
3500 *   Polyethylene
3501          SPO = 5./DCOS(THET)
3502          P = P+SPO/1000.*0.935*(2.22D-3 * P+2.17)
3503 *   Plomb
3504          SPB = 5./DCOS(THET)
3505          P = P+SPB/1000.*11.35*(16.66D-3 * P+1.33)
3506
3507       ELSE
3508 *   Tungstene
3509          SW = (503.-467.)/DCOS(THET)
3510          P = P+SW/1000.*19.3*(16.66D-3 * P+1.33)
3511       ENDIF
3512
3513 *   Concrete
3514       SCONC = (467.-315.)/DCOS(THET)
3515       P = P+SCONC/1000.*2.5*(2.22D-3*P+2.17)
3516
3517 *   Carbone
3518       SC = (315.-90.)/DCOS(THET)
3519       P = P+SC/1000.*1.93*(2.22D-3*P+2.17) ! Carbone
3520
3521       DEDX = P
3522
3523       RETURN
3524
3525       END
3526 */
3527
3528 ************************************************************************
3529       SUBROUTINE BRANSON(PXZ,PHI,ALAM,XEA,YEA)
3530 ************************************************************************
3531 *
3532 *   Correction de Branson du multiple scattering dans l'absorbeur
3533 *
3534 ************************************************************************
3535
3536       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3537
3538       PARAMETER(NPLANE=10)
3539       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
3540      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
3541
3542       ASIGN = 1.
3543       IF (PXZ.LT.0.) ASIGN = -1.
3544       PXZ = DABS(PXZ)
3545       PX = PXZ*DSIN(PHI)
3546       PY = PXZ*DTAN(ALAM)
3547       PZ = PXZ*DCOS(PHI)
3548
3549       PTOT = PXZ/DCOS(ALAM)
3550
3551       ZEA = ZABS
3552
3553       REA = DSQRT(XEA**2+YEA**2)
3554       IF (REA.GT.26.3611) THEN
3555          ZBP = ZBP1
3556       ELSE            ! Abso. W  pour theta < 3 deg
3557          ZBP = ZBP2
3558       ENDIF
3559 *      ZBP = ZEA ! Andreas
3560       XBP = XEA-PX/PZ*(ZEA-ZBP)
3561       YBP = YEA-PY/PZ*(ZEA-ZBP)
3562       PZ = PTOT*ZBP/DSQRT(XBP**2+YBP**2+ZBP**2)
3563       PX = PZ*XBP/ZBP
3564       PY = PZ*YBP/ZBP
3565       PXZ = DSQRT(PX**2+PZ**2)
3566       PHI = DATAN2(PX,PZ)
3567       ALAM = DATAN2(PY,PXZ)
3568
3569 **      THET = DATAN2(REA,ZEA)
3570
3571       PT = DSQRT(PX**2+PY**2)
3572       THET = DATAN2(PT,PZ)
3573       PTOT =  DEDX(PTOT,THET,XEA,YEA)
3574
3575       PXZ = ASIGN*PTOT*DCOS(ALAM)
3576
3577       RETURN
3578       END
3579
3580 ***************************************************************
3581       SUBROUTINE DSINV(N,A,IDIM,IFAIL)
3582 ***************************************************************
3583
3584       DOUBLE PRECISION    A(IDIM,*),  ZERO,  ONE,  X, Y
3585
3586       REAL                PIVOTF
3587       CHARACTER*6         HNAME
3588
3589       DOUBLE PRECISION    S1, S31, S32, S33,  DOTF
3590
3591       PIVOTF(X)    =  SNGL(X)
3592       DOTF(X,Y,S1)  =  X * Y + S1
3593
3594       DATA      HNAME               /  'DSINV '  /
3595       DATA      ZERO, ONE           /  0.D0, 1.D0 /
3596
3597       IF(IDIM .LT. N  .OR.  N .LE. 0)  GOTO 900
3598 *
3599 * sfact.inc
3600 *
3601       IFAIL  =  0
3602       DO 144    J  =  1, N
3603          IF(PIVOTF(A(J,J)) .LE. 0.)  GOTO 150
3604          A(J,J)  =  ONE / A(J,J)
3605          IF(J .EQ. N)  GOTO 199
3606  140     JP1  =  J+1
3607          DO 143   L  =  JP1, N
3608             A(J,L)  =  A(J,J)*A(L,J)
3609             S1      =  -A(L,J+1)
3610             DO 141  I  =  1, J
3611                S1  =  DOTF(A(L,I),A(I,J+1),S1)
3612  141        CONTINUE
3613             A(L,J+1)  =  -S1
3614  143     CONTINUE
3615  144  CONTINUE
3616  150  IFAIL  =  -1
3617       RETURN
3618  199  CONTINUE
3619 *
3620 * sfinv.inc
3621 *
3622       IF(N .EQ. 1)  GOTO 399
3623       A(1,2)  =  -A(1,2)
3624       A(2,1)  =   A(1,2)*A(2,2)
3625       IF(N .EQ. 2)  GOTO 320
3626       DO 314    J  =  3, N
3627          JM2  =  J - 2
3628          DO 312 K  =  1, JM2
3629             S31  =  A(K,J)
3630             DO 311  I  =  K, JM2
3631                S31  =  DOTF(A(K,I+1),A(I+1,J),S31)
3632  311        CONTINUE
3633             A(K,J)  =  -S31
3634             A(J,K)  =  -S31*A(J,J)
3635  312     CONTINUE
3636          A(J-1,J)  =  -A(J-1,J)
3637          A(J,J-1)  =   A(J-1,J)*A(J,J)
3638  314  CONTINUE
3639  320  J  =  1
3640  323  S33  =  A(J,J)
3641       IF(J .EQ. N)  GOTO 325
3642       JP1  =  J + 1
3643       DO 324 I  =  JP1, N
3644          S33  =  DOTF(A(J,I),A(I,J),S33)
3645  324  CONTINUE
3646  325  A(J,J)  =  S33
3647       JM1  =  J
3648       J    =  JP1
3649       DO 328 K  =  1, JM1
3650          S32  =  ZERO
3651          DO 327  I  =  J, N
3652             S32  =  DOTF(A(K,I),A(I,J),S32)
3653  327     CONTINUE
3654          A(K,J)  =  S32
3655          A(J,K)  =  S32
3656  328  CONTINUE
3657       IF(J .LT. N)  GOTO 323
3658  399  CONTINUE
3659
3660       RETURN
3661  900  CALL TMPRNT(HNAME,N,IDIM,0)
3662       RETURN
3663       END
3664
3665 *******************************************************
3666       SUBROUTINE TMPRNT(NAME,N,IDIM,K)
3667 *******************************************************
3668
3669       CHARACTER*6         NAME
3670       LOGICAL             MFLAG,    RFLAG
3671
3672       IF(NAME(2:2) .EQ. 'S') THEN
3673          CALL KERMTR('F012.1',LGFILE,MFLAG,RFLAG)
3674       ELSE
3675          CALL KERMTR('F011.1',LGFILE,MFLAG,RFLAG)
3676       ENDIF
3677       IF(NAME(3:6) .EQ. 'FEQN') ASSIGN 1002 TO IFMT
3678       IF(NAME(3:6) .NE. 'FEQN') ASSIGN 1001 TO IFMT
3679       IF(MFLAG) THEN
3680          IF(LGFILE .EQ. 0) THEN
3681             IF(NAME(3:6) .EQ. 'FEQN') THEN
3682                WRITE(*,IFMT) NAME, N, IDIM, K
3683             ELSE
3684                WRITE(*,IFMT) NAME, N, IDIM
3685             ENDIF
3686          ELSE
3687             IF(NAME(3:6) .EQ. 'FEQN') THEN
3688                WRITE(LGFILE,IFMT) NAME, N, IDIM, K
3689             ELSE
3690                WRITE(LGFILE,IFMT) NAME, N, IDIM
3691             ENDIF
3692          ENDIF
3693       ENDIF
3694       IF(.NOT. RFLAG) CALL ABEND
3695       RETURN
3696  1001 FORMAT(7X, 31H PARAMETER ERROR IN SUBROUTINE , A6,
3697      +     27H ... (N.LT.1 OR IDIM.LT.N).,
3698      +             5X, 3HN =, I4, 5X, 6HIDIM =, I4, 1H. )
3699  1002 FORMAT(7X, 31H PARAMETER ERROR IN SUBROUTINE , A6,
3700      +     37H ... (N.LT.1 OR IDIM.LT.N OR K.LT.1).,
3701      +     5X, 3HN =, I4, 5X, 6HIDIM =, I4, 5X, 3HK =, I4,1H.)
3702       END
3703 *
3704 * $Id$
3705 *
3706 * $Log$
3707 * Revision 1.5  2000/06/15 07:58:49  morsch
3708 * Code from MUON-dev joined
3709 *
3710 * Revision 1.4.4.2  2000/04/26 15:48:37  morsch
3711 * Some routines from obsolete algo.F are needed by reco_muon.F and have been
3712 * copied there.
3713 *
3714 * Revision 1.4.4.1  2000/01/12 16:00:55  morsch
3715 * New version of MUON code
3716 *
3717 * Revision 1.1.1.1  1996/02/15 17:48:35  mclareni
3718 * Kernlib
3719 *
3720 *
3721
3722 ***********************************************************
3723       SUBROUTINE KERSET(ERCODE,LGFILE,LIMITM,LIMITR)
3724 ***********************************************************
3725
3726       PARAMETER(KOUNTE  =  27)
3727       CHARACTER*6         ERCODE,   CODE(KOUNTE)
3728       LOGICAL             MFLAG,    RFLAG
3729       INTEGER             KNTM(KOUNTE),       KNTR(KOUNTE)
3730
3731       DATA      LOGF      /  0  /
3732       DATA      CODE(1), KNTM(1), KNTR(1)  / 'C204.1', 255, 255 /
3733       DATA      CODE(2), KNTM(2), KNTR(2)  / 'C204.2', 255, 255 /
3734       DATA      CODE(3), KNTM(3), KNTR(3)  / 'C204.3', 255, 255 /
3735       DATA      CODE(4), KNTM(4), KNTR(4)  / 'C205.1', 255, 255 /
3736       DATA      CODE(5), KNTM(5), KNTR(5)  / 'C205.2', 255, 255 /
3737       DATA      CODE(6), KNTM(6), KNTR(6)  / 'C305.1', 255, 255 /
3738       DATA      CODE(7), KNTM(7), KNTR(7)  / 'C308.1', 255, 255 /
3739       DATA      CODE(8), KNTM(8), KNTR(8)  / 'C312.1', 255, 255 /
3740       DATA      CODE(9), KNTM(9), KNTR(9)  / 'C313.1', 255, 255 /
3741       DATA      CODE(10),KNTM(10),KNTR(10) / 'C336.1', 255, 255 /
3742       DATA      CODE(11),KNTM(11),KNTR(11) / 'C337.1', 255, 255 /
3743       DATA      CODE(12),KNTM(12),KNTR(12) / 'C341.1', 255, 255 /
3744       DATA      CODE(13),KNTM(13),KNTR(13) / 'D103.1', 255, 255 /
3745       DATA      CODE(14),KNTM(14),KNTR(14) / 'D106.1', 255, 255 /
3746       DATA      CODE(15),KNTM(15),KNTR(15) / 'D209.1', 255, 255 /
3747       DATA      CODE(16),KNTM(16),KNTR(16) / 'D509.1', 255, 255 /
3748       DATA      CODE(17),KNTM(17),KNTR(17) / 'E100.1', 255, 255 /
3749       DATA      CODE(18),KNTM(18),KNTR(18) / 'E104.1', 255, 255 /
3750       DATA      CODE(19),KNTM(19),KNTR(19) / 'E105.1', 255, 255 /
3751       DATA      CODE(20),KNTM(20),KNTR(20) / 'E208.1', 255, 255 /
3752       DATA      CODE(21),KNTM(21),KNTR(21) / 'E208.2', 255, 255 /
3753       DATA      CODE(22),KNTM(22),KNTR(22) / 'F010.1', 255,   0 /
3754       DATA      CODE(23),KNTM(23),KNTR(23) / 'F011.1', 255,   0 /
3755       DATA      CODE(24),KNTM(24),KNTR(24) / 'F012.1', 255,   0 /
3756       DATA      CODE(25),KNTM(25),KNTR(25) / 'F406.1', 255,   0 /
3757       DATA      CODE(26),KNTM(26),KNTR(26) / 'G100.1', 255, 255 /
3758       DATA      CODE(27),KNTM(27),KNTR(27) / 'G100.2', 255, 255 /
3759
3760       LOGF  =  LGFILE
3761       L  =  0
3762       IF(ERCODE .NE. ' ')  THEN
3763          DO 10  L = 1, 6
3764             IF(ERCODE(1:L) .EQ. ERCODE)  GOTO 12
3765  10      CONTINUE
3766  12      CONTINUE
3767       ENDIF
3768       DO 14     I  =  1, KOUNTE
3769          IF(L .EQ. 0)  GOTO 13
3770          IF(CODE(I)(1:L) .NE. ERCODE(1:L))  GOTO 14
3771  13      IF(LIMITM.GE.0) KNTM(I)  =  LIMITM
3772          IF(LIMITR.GE.0) KNTR(I)  =  LIMITR
3773  14   CONTINUE
3774       RETURN
3775       ENTRY KERMTR(ERCODE,LOG,MFLAG,RFLAG)
3776       LOG  =  LOGF
3777       DO 20     I  =  1, KOUNTE
3778          IF(ERCODE .EQ. CODE(I))  GOTO 21
3779  20   CONTINUE
3780       WRITE(*,1000)  ERCODE
3781       CALL ABEND
3782       RETURN
3783  21   RFLAG  =  KNTR(I) .GE. 1
3784       IF(RFLAG  .AND.  (KNTR(I) .LT. 255))  KNTR(I)  =  KNTR(I) - 1
3785       MFLAG  =  KNTM(I) .GE. 1
3786       IF(MFLAG  .AND.  (KNTM(I) .LT. 255))  KNTM(I)  =  KNTM(I) - 1
3787       IF(.NOT. RFLAG)  THEN
3788          IF(LOGF .LT. 1)  THEN
3789             WRITE(*,1001)  CODE(I)
3790          ELSE
3791             WRITE(LOGF,1001)  CODE(I)
3792          ENDIF
3793       ENDIF
3794       IF(MFLAG .AND. RFLAG)  THEN
3795          IF(LOGF .LT. 1)  THEN
3796             WRITE(*,1002)  CODE(I)
3797          ELSE
3798             WRITE(LOGF,1002)  CODE(I)
3799          ENDIF
3800       ENDIF
3801       RETURN
3802  1000 FORMAT(' KERNLIB LIBRARY ERROR. ' /
3803      +     ' ERROR CODE ',A6,' NOT RECOGNIZED BY KERMTR',
3804      +     ' ERROR MONITOR. RUN ABORTED.')
3805  1001 FORMAT(/' ***** RUN TERMINATED BY CERN LIBRARY ERROR ',
3806      +     'CONDITION ',A6)
3807  1002 FORMAT(/' ***** CERN LIBRARY ERROR CONDITION ',A6)
3808       END
3809
3810 **************************
3811       subroutine abend
3812 **************************
3813
3814       stop 'abend!'
3815       end
3816
3817 ************************************************************************
3818       SUBROUTINE FCNFIT(NPAR, GRAD, FVAL, XVAL, IFLAG, FUTIL)
3819 ************************************************************************
3820 *    With magnetic Field Map GRKUTA
3821 *
3822 *    Calcule FVAL: la fonction minimisee par MINUIT
3823 *    With magnetic field map
3824 *
3825 ************************************************************************
3826       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3827
3828       PARAMETER(NPLANE=10)
3829
3830       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
3831      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
3832
3833       COMMON/MEAS/LPLANE(NPLANE),XMP(NPLANE),YMP(NPLANE)
3834
3835       COMMON/FCNOUT/PXZEA,ALAMEA,PHIEA,XEA,YEA,NPLU,CHI2
3836
3837
3838       DIMENSION GRAD(*),XVAL(*),AMS(500),DISTAZ(500)
3839
3840       DIMENSION XP(NPLANE),YP(NPLANE),
3841      &          COV(NPLANE,NPLANE),AP(NPLANE),COVY(NPLANE,NPLANE)
3842       DIMENSION VECT(7),VOUT(7)
3843
3844       STEP = 2.   ! 1 cm
3845       NSTEPMAX = 5000
3846       PITODEG = 57.295
3847       XV = XVAL(4)
3848       YV = XVAL(5)
3849
3850       ASIGN = 1.
3851       IF (XVAL(1).LT.0.) ASIGN = -1.
3852       PHI  = XVAL(2)
3853       ALAM = XVAL(3)
3854       PXZ = DABS(1./XVAL(1))
3855
3856       PX = PXZ*DSIN(PHI)
3857       PY = PXZ*DTAN(ALAM)
3858       PZ = PXZ*DCOS(PHI)
3859       PTOT = PXZ/DCOS(ALAM)
3860
3861       A12 = 0.
3862       NTMAX = 0
3863
3864       ZEA = ZABS
3865       XEA = XV
3866       YEA = YV
3867       PXEA = PX
3868       PYEA = PY
3869       PHIEA = PHI
3870       PXZEA = ASIGN*PXZ
3871       ALAMEA = ALAM
3872
3873       VECT(1) = XV
3874       VECT(2) = YV
3875       VECT(3) = ZABS
3876       VECT(4) = PX/PTOT
3877       VECT(5) = PY/PTOT
3878       VECT(6) = PZ/PTOT
3879       VECT(7) = PTOT
3880
3881       R = SQRT(VECT(1)*VECT(1)+VECT(2)*VECT(2))
3882
3883       Z = VECT(3)
3884       NSTEP = 0
3885       IX = 0
3886       IY = 0
3887       IZ = 0
3888 **      PRINT *,' AV GRKUTA ASIGN',ASIGN,' THET',THET
3889       DO ICH = 1,NPLANE
3890          DO WHILE (Z.GE.ZABS.AND.Z.LT.ZPLANEP(ICH)
3891      &            .AND.NSTEP.LE.NSTEPMAX)
3892 **     &            .AND.(THETA*PITODEG).GT.2.
3893 **     &            .AND. (THETA*PITODEG).LT.9.)
3894             NSTEP = NSTEP+1
3895 **          WRITE(6,*) NSTEP,(VECT(I),I=1,7)
3896 **            CALL RECO_GRKUTA(ASIGN,STEP,VECT,VOUT) ! CCC
3897             CALL RECO_GHELIX(ASIGN,STEP,VECT,VOUT)
3898             DO I = 1,7
3899                VECT(I) = VOUT(I)
3900             ENDDO
3901             Z = VECT(3)
3902             R = SQRT(VECT(1)*VECT(1)+VECT(2)*VECT(2))
3903          ENDDO
3904          IF (NSTEP.EQ.NSTEPMAX) RETURN
3905          XP(ICH) = VECT(1)-(Z-ZPLANEP(ICH))*VECT(4)/VECT(6)
3906          YP(ICH) = VECT(2)-(Z-ZPLANEP(ICH))*VECT(5)/VECT(6)
3907          AL   = THICK/ VECT(6)
3908          AP(ICH) = (0.0136D0/PTOT)*DSQRT(AL)*(1+0.038D0*DLOG(AL))
3909       ENDDO
3910 **    PRINT *,' AP GRKUTA ASIGN',ASIGN,' THET',THET
3911
3912
3913 ** Matrice de covariance
3914       I = 0
3915       DO II = 1,NPLANE
3916         IF (LPLANE(II).EQ.1) THEN
3917            I = I + 1
3918 *     I = II
3919            J = I - 1
3920            DO JJ = II, NPLANE
3921               IF (LPLANE(JJ).EQ.1) THEN
3922                  J = J + 1
3923 *     J = JJ
3924                  COV (I,J) = 0.0D0
3925                  COV (J,I) = A12
3926                  IF (I .EQ. J) THEN
3927                     COV(J,I) =COV(J,I) + XPREC**2
3928                  ENDIF
3929
3930 *     IF (I .EQ. 10 .AND. J .EQ. 10) PRINT *,'10 10   ',COV(J,I)
3931 **                 DO L = 1,NTMAX
3932 **                    COV(J,I) = COV(J,I)
3933 **     &                   +  (ZPLANEP(II) + DISTAZ(L))*(ZPLANEP(JJ) +
3934 **     &                   DISTAZ(L))*AMS(L)**2
3935 **                 ENDDO
3936                  DO K = 1, II-1
3937                     COV(J,I) = COV(J,I)
3938      &                   +  (ZPLANEP(II)-ZPLANEP(K))*
3939      &                   (ZPLANEP(JJ)-ZPLANEP(K))*AP(K)**2
3940 *     IF (I .EQ. 10 .AND. J .EQ. 10) PRINT *,'10 10   ',COV(J,I)
3941                  ENDDO
3942                  COVY(I,J) = 0.0D0
3943                  COVY(J,I) = COV(J,I)
3944                  IF (I .EQ. J) THEN
3945                     COVY(J,I) = COVY(J,I) - XPREC**2 + YPREC**2
3946                  ENDIF
3947               ENDIF
3948            ENDDO
3949         ENDIF
3950       ENDDO
3951
3952 *  Inversion des matrices de covariance
3953       NPLU = I
3954
3955       IFAIL = 0
3956       CALL DSINV(NPLU, COV, NPLANE, IFAIL)
3957 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
3958       IF (IFAIL .NE. 0) STOP 'ERROR'
3959       IFAIL = 0
3960       CALL DSINV(NPLU, COVY, NPLANE, IFAIL)
3961 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
3962       IF (IFAIL .NE. 0) STOP 'ERROR'
3963 *      PRINT *,' COVARIANCE MATRIX AFTER'
3964 *      DO I = 1, NPLANE
3965 *         PRINT *,(COV(J,I),J=1,NPLANE)
3966 *      ENDDO
3967
3968 ** Calcul de FVAL ou CHI2
3969       FVAL = 0.0D0
3970       I = 0
3971       DO II = 1,NPLANE
3972         IF (LPLANE(II).EQ.1) THEN
3973         I = I+1
3974 *        I = II
3975         J = 0
3976         DO JJ = 1,NPLANE
3977            IF (LPLANE(JJ).EQ.1) THEN
3978               J = J+1
3979 *             J = JJ
3980               FVAL = FVAL + COV(J,I)*(XMP(II)-XP(II))*(XMP(JJ)-XP(JJ))
3981               FVAL = FVAL + COVY(J,I)*(YMP(II)-YP(II))
3982      &                               *(YMP(JJ)-YP(JJ))
3983 **             IF (JJ.EQ.II) THEN
3984 **                 FVAL = FVAL + (XM(II)-XP(II))*(XM(JJ)-XP(JJ))/XPREC**2
3985 **                 FVAL = FVAL + (YM(II)-YP(II))
3986 **     &                               *(YM(JJ)-YP(JJ))/YPREC**2
3987 **             ENDIF
3988            ENDIF
3989         ENDDO
3990         ENDIF
3991       ENDDO
3992       CHI2 = FVAL
3993
3994 **      IF (CHI2.GT.1.E4) THEN
3995 **         PRINT *,'FCNFIT CHI2= ',CHI2
3996 **         FVAL = 0.
3997 **      ENDIF
3998
3999
4000  1000 FORMAT(I5,7F12.6)
4001
4002       RETURN
4003       END
4004
4005 ************************************************************************
4006       SUBROUTINE NEWFCNFIT(NPAR, GRAD, FVAL, XVAL, IFLAG, FUTIL)
4007 ************************************************************************
4008 *    With magnetic Field Map GRKUTA
4009 *      trackfinding
4010 *    Calcule FVAL: la fonction minimisee par MINUIT
4011 *    With magnetic field map
4012 *
4013 ************************************************************************
4014       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
4015
4016       PARAMETER(NPLANE=10)
4017
4018       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
4019      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
4020
4021       COMMON/MEAS/LPLANE(NPLANE),XMP(NPLANE),YMP(NPLANE)
4022
4023       COMMON/FCNOUT/PXZEA,ALAMEA,PHIEA,XEA,YEA,NPLU,CHI2
4024
4025       DIMENSION GRAD(*),XVAL(*),AMS(500),DISTAZ(500)
4026
4027       DIMENSION XP(NPLANE),YP(NPLANE),
4028      &          COV(NPLANE,NPLANE),AP(NPLANE),COVY(NPLANE,NPLANE)
4029       DIMENSION VECT(7),VOUT(7)
4030
4031       STEP = 2.   ! 1 cm
4032       NSTEPMAX = 5000
4033       PITODEG = 57.295
4034       XV = XVAL(4)
4035       YV = XVAL(5)
4036
4037       ASIGN = 1.
4038       IF (XVAL(1).LT.0.) ASIGN = -1.
4039       PHI  = XVAL(2)
4040       ALAM = XVAL(3)
4041       PXZ = DABS(1./XVAL(1))
4042
4043       PX = PXZ*DSIN(PHI)
4044       PY = PXZ*DTAN(ALAM)
4045       PZ = PXZ*DCOS(PHI)
4046       PTOT = PXZ/DCOS(ALAM)
4047
4048       A12 = 0.
4049       NTMAX = 0
4050
4051       ZEA = ZABS
4052       XEA = XV
4053       YEA = YV
4054       PXEA = PX
4055       PYEA = PY
4056       PHIEA = PHI
4057       PXZEA = ASIGN*PXZ
4058       ALAMEA = ALAM
4059
4060       VECT(1) = XV
4061       VECT(2) = YV
4062       VECT(3) = ZABS
4063       VECT(4) = PX/PTOT
4064       VECT(5) = PY/PTOT
4065       VECT(6) = PZ/PTOT
4066       VECT(7) = PTOT
4067
4068       R = SQRT(VECT(1)*VECT(1)+VECT(2)*VECT(2))
4069
4070       Z = VECT(3)
4071       NSTEP = 0
4072       IX = 0
4073       IY = 0
4074       IZ = 0
4075 **      PRINT *,' AV GRKUTA ASIGN',ASIGN,' THET',THET
4076       DO ICH = 1,NPLANE
4077          DO WHILE (Z.GE.ZABS.AND.Z.LT.ZPLANEP(ICH)
4078      &            .AND.NSTEP.LE.NSTEPMAX)
4079 **     &            .AND.(THETA*PITODEG).GT.2.
4080 **     &            .AND. (THETA*PITODEG).LT.9.)
4081             NSTEP = NSTEP+1
4082 **          WRITE(6,*) NSTEP,(VECT(I),I=1,7)
4083             CALL RECO_GRKUTA (ASIGN,STEP,VECT,VOUT)
4084             DO I = 1,7
4085                VECT(I) = VOUT(I)
4086             ENDDO
4087             Z = VECT(3)
4088             R = SQRT(VECT(1)*VECT(1)+VECT(2)*VECT(2))
4089          ENDDO
4090          IF (NSTEP.EQ.NSTEPMAX) RETURN
4091          XP(ICH) = VECT(1)-(Z-ZPLANEP(ICH))*VECT(4)/VECT(6)
4092          YP(ICH) = VECT(2)-(Z-ZPLANEP(ICH))*VECT(5)/VECT(6)
4093          AL   = THICK/ VECT(6)
4094          AP(ICH) = (0.0136D0/PTOT)*DSQRT(AL)*(1+0.038D0*DLOG(AL))
4095       ENDDO
4096 **    PRINT *,' AP GRKUTA ASIGN',ASIGN,' THET',THET
4097
4098
4099 ** Matrice de covariance
4100       I = 0
4101       DO II = 1,NPLANE
4102         IF (LPLANE(II).EQ.1) THEN
4103            I = I + 1
4104 *     I = II
4105            J = I - 1
4106            DO JJ = II, NPLANE
4107               IF (LPLANE(JJ).EQ.1) THEN
4108                  J = J + 1
4109 *     J = JJ
4110                  COV (I,J) = 0.0D0
4111                  COV (J,I) = A12
4112                  IF (I .EQ. J) THEN
4113                     COV(J,I) =COV(J,I) + XPREC**2
4114                  ENDIF
4115
4116 *     IF (I .EQ. 10 .AND. J .EQ. 10) PRINT *,'10 10   ',COV(J,I)
4117                  DO L = 1,NTMAX
4118                     COV(J,I) = COV(J,I)
4119      &                   +  (ZPLANEP(II) + DISTAZ(L))*(ZPLANEP(JJ) +
4120      &                   DISTAZ(L))*AMS(L)**2
4121                  ENDDO
4122                  DO K = 1, II-1
4123                     COV(J,I) = COV(J,I)
4124      &                   +  (ZPLANEP(II)-ZPLANEP(K))*
4125      &                   (ZPLANEP(JJ)-ZPLANEP(K))*AP(K)**2
4126 *     IF (I .EQ. 10 .AND. J .EQ. 10) PRINT *,'10 10   ',COV(J,I)
4127                  ENDDO
4128                  COVY(I,J) = 0.0D0
4129                  COVY(J,I) = COV(J,I)
4130                  IF (I .EQ. J) THEN
4131                     COVY(J,I) = COVY(J,I) - XPREC**2 + YPREC**2
4132                  ENDIF
4133               ENDIF
4134            ENDDO
4135         ENDIF
4136       ENDDO
4137
4138 *  Inversion des matrices de covariance
4139       NPLU = I
4140
4141       IFAIL = 0
4142       CALL DSINV(NPLU, COV, NPLANE, IFAIL)
4143 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
4144       IF (IFAIL .NE. 0) STOP 'ERROR'
4145       IFAIL = 0
4146       CALL DSINV(NPLU, COVY, NPLANE, IFAIL)
4147 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
4148       IF (IFAIL .NE. 0) STOP 'ERROR'
4149 *      PRINT *,' COVARIANCE MATRIX AFTER'
4150 *      DO I = 1, NPLANE
4151 *         PRINT *,(COV(J,I),J=1,NPLANE)
4152 *      ENDDO
4153
4154 ** Calcul de FVAL ou CHI2
4155       FVAL = 0.0D0
4156       I = 0
4157       DO II = 1,NPLANE
4158         IF (LPLANE(II).EQ.1) THEN
4159         I = I+1
4160 *        I = II
4161         J = 0
4162         DO JJ = 1,NPLANE
4163            IF (LPLANE(JJ).EQ.1) THEN
4164               J = J+1
4165 *             J = JJ
4166               FVAL = FVAL + COV(J,I)*(XMP(II)-XP(II))*(XMP(JJ)-XP(JJ))
4167               FVAL = FVAL + COVY(J,I)*(YMP(II)-YP(II))
4168      &                               *(YMP(JJ)-YP(JJ))
4169 **             IF (JJ.EQ.II) THEN
4170 **                 FVAL = FVAL + (XM(II)-XP(II))*(XM(JJ)-XP(JJ))/XPREC**2
4171 **                 FVAL = FVAL + (YM(II)-YP(II))
4172 **     &                               *(YM(JJ)-YP(JJ))/YPREC**2
4173 **             ENDIF
4174            ENDIF
4175         ENDDO
4176         ENDIF
4177       ENDDO
4178       CHI2 = FVAL
4179
4180 **      IF (CHI2.GT.1.E4) THEN
4181 **         PRINT *,'FCNFIT CHI2= ',CHI2
4182 **         FVAL = 0.
4183 **      ENDIF
4184
4185
4186  1000 FORMAT(I5,7F12.6)
4187
4188       RETURN
4189       END
4190
4191 ***********************************************************************
4192       SUBROUTINE INITFIELDOLD
4193 *
4194 *   Galina
4195 ***********************************************************************
4196
4197       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4198
4199 **      IMPLICIT REAL*8(A-H,O-Z)
4200 **      REAL *4 BX,BY,BZ
4201       COMMON/DAT1/Z(81),X(81),Y(81,44),DX,DZ,LPX,LPY,LPZ
4202       COMMON/DAT2/BX(81,81,44),BY(81,81,44),BZ(81,81,44)
4203       COMMON/REG1/ZMAX,ZMIN,XMAX,XMIN
4204       COMMON/REG2/AY1,CY1,AY2,CY2
4205 **      REAL *4 BXP,BYP,BZP
4206       COMMON/SDAT1/ZP(51),RAD(10),FI(33),DZP,DFI,DR,YY0,LPPZ,NR,NFI
4207       COMMON/SDAT2/BXP(51,10,33),BYP(51,10,33),BZP(51,10,33)
4208       COMMON/SDAT4/B(2,2,32)
4209       COMMON/REG3/ZPMAX,ZPMIN,RMAX,RMIN
4210 cc      COMMON/CONST/PI2,EPS
4211       REWIND 40
4212  1000 FORMAT(5(1X,D15.7))
4213  2000 FORMAT(5(1X,I5))
4214       READ(40,2000) LPX,LPY,LPZ
4215       READ(40,1000) (Z(K),K=1,81)
4216       READ(40,1000) (X(K),K=1,81)
4217       READ(40,1000) DX,DY,DZ
4218       READ(40,1000) ZMAX,ZMIN,XMAX,XMIN
4219 c      write(*,*) 'zmin zmax',ZMIN,ZMAX
4220 c      write(*,*) 'xmin xmax',XMIN,XMAX
4221       READ(40,1000) AY1,CY1,AY2,CY2
4222 c      write(*,*) 'ay1,cy1,ay2,cy2', AY1,CY1,AY2,CY2
4223 cc      READ(40,1000) PI2,EPS
4224       READ(40,1000) (((BX(K,L,M),K=1,81),L=1,81),M=1,44)
4225       READ(40,1000) (((BY(K,L,M),K=1,81),L=1,81),M=1,44)
4226       READ(40,1000) (((BZ(K,L,M),K=1,81),L=1,81),M=1,44)
4227 **      RETURN
4228 **      END
4229 c Polar part
4230       READ(40,2000) LPPZ,NR,NFI
4231       READ(40,1000) (ZP(K),K=1,51)
4232       READ(40,1000) (RAD(K),K=1,10)
4233       READ(40,1000) (FI(L),L=1,33)
4234       READ(40,1000) DZP,DFI,DR
4235 c      write(*,*) 'dzp dfi dR',DZP,DFI,DR
4236       READ(40,1000) ZPMAX,ZPMIN,RMAX,RMIN
4237 c      write(*,*) 'zmin zmax',ZPMIN,ZPMAX
4238 c     write(*,*) 'Rmin Rmax',RMIN,RMAX
4239       READ(40,1000) (((BXP(K,L,M),K=1,51),L=1,10),M=1,33)
4240       READ(40,1000) (((BYP(K,L,M),K=1,51),L=1,10),M=1,33)
4241       READ(40,1000) (((BZP(K,L,M),K=1,51),L=1,10),M=1,33)
4242       READ(40,1000) (((B(K,L,M),K=1,2),L=1,2),M=1,32)
4243 **      RETURN
4244 **      END
4245
4246
4247
4248
4249       RETURN
4250       END
4251
4252 ***********************************************************************
4253       SUBROUTINE RECO_GUFLDOLD(X,F)
4254 C     ^^^^^^^^^^^^^^^^^^^^^^
4255 C   field map G. Chabratova
4256 C
4257 C  Field map 31/05/99
4258 ***********************************************************************
4259
4260
4261       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4262       COMMON/MAGERR/IMAGERR
4263
4264       DIMENSION X(7),F(3)
4265
4266       XT = X(2)
4267       X(2) = X(1)
4268       X(1) = XT
4269
4270       X0 = X(1)/100.
4271       Y0 = X(2)/100.
4272       Z0 = X(3)/100.
4273
4274       CALL FREG1(Z0,X0,Y0,FZ0,FX0,FY0,IND)
4275 **    PRINT 3000,Z0,X0,Y0,FZ0,FX0,FY0,IND
4276
4277       IF(IND.EQ.0) GOTO 1
4278       CALL FREG2(Z0,X0,Y0,FZ0,FX0,FY0,IND)
4279       IMAGERR = 0
4280       IF(IND.EQ.2) THEN
4281         IMAGERR = 1
4282 **        print 1000
4283 **        PRINT 3000,Z0,X0,Y0,FZ0,FX0,FY0,IND
4284       ENDIF
4285  1000 format(1x,'Attention!!! The point is out of range!!!')
4286
4287  3000 FORMAT(1X,'Z=',D13.7,1X,'X=',D13.7,1X,'Y=',D13.7,1X,
4288      & 'BZ=',D13.7,1X,'BX=',D13.7,1X,'BY=',D13.7,1X,'IND=',I3)
4289
4290   1   F(1) = FX0*10.
4291       F(2) = FY0*10.
4292       F(3) = FZ0*10.
4293
4294 **      X(1) = X0*100.
4295 **      X(2) = Y0*100.
4296 **      X(3) = Z0*100.
4297
4298
4299       FT = F(2)
4300       F(2) = F(1)
4301       F(1) = FT
4302
4303       XT = X(2)
4304       X(2) = X(1)
4305       X(1) = XT
4306
4307       RETURN
4308       END
4309
4310
4311 **************************************************
4312       SUBROUTINE FREG1(Z0,X0,Y0,FZ0,FX0,FY0,IND)
4313 **************************************************
4314       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4315 **      REAL *4 BX,BY,BZ
4316       COMMON/DAT1/Z(81),X(81),Y(81,44),DX,DZ,LPX,LPY,LPZ
4317       COMMON/DAT2/BX(81,81,44),BY(81,81,44),BZ(81,81,44)
4318       COMMON/REG1/ZMAX,ZMIN,XMAX,XMIN
4319       COMMON/REG2/AY1,CY1,AY2,CY2
4320       KC=1
4321       LC=1
4322       MC=1
4323       IND=0
4324       IF(Z0.LT.ZMIN.OR.Z0.GT.ZMAX)GO TO 100
4325       IF(X0.LT.XMIN.OR.X0.GT.XMAX)GO TO 100
4326       YY1=AY1*Z0+CY1
4327       YY2=AY2*Z0+CY2
4328  2000 FORMAT(1X,'YY1=',D15.7,1X,'YY2=',D15.7,1X,'Y0=',D15.7)
4329 c      PRINT 2000,YY1,YY2,Y0
4330       IF(Y0.LT.YY1)GO TO 100
4331       IF(Y0.GT.YY2)GO TO 100
4332       CALL FIZ(Z0,Z,DZ,KC,K0,Z1,Z2,81)
4333       CALL FIZ(X0,X,DX,LC,L0,X1,X2,81)
4334       DY=(YY2-YY1)/DFLOAT(LPY-1)
4335       YY=(Y0-YY1)
4336       M0=(YY/DY)
4337
4338       IF(Y0.GE.(YY1+DFLOAT(M0)*DY).AND.Y0.LE.(YY1+DFLOAT(M0+1)*DY))
4339      &GO TO 700
4340       M0=M0+1
4341  700  CONTINUE
4342       Y2=(Y0-(YY1+DFLOAT(M0)*DY))/DY
4343       Y1=1.-Y2
4344 **    write(*,*) 'm0 Y1 Y2',m0,Y1,Y2
4345 **    print *,' k0=',k0,' l0=',l0,' m0=',m0
4346 **    print *,' z1=',z1,' z2=',z2
4347       FX1=Z1*BX(K0,L0,M0)+Z2*BX(K0+1,L0,M0)
4348       FX2=Z2*BX(K0+1,L0+1,M0)+Z1*BX(K0,L0+1,M0)
4349       FFX1=X1*FX1+X2*FX2
4350       GX1=Z1*BX(K0,L0,M0+1)+Z2*BX(K0+1,L0,M0+1)
4351       GX2=Z2*BX(K0+1,L0+1,M0+1)+Z1*BX(K0,L0+1,M0+1)
4352       GGX1=X1*GX1+X2*GX2
4353       FX0=Y1*FFX1+Y2*GGX1
4354       FX1=Z1*BY(K0,L0,M0)+Z2*BY(K0+1,L0,M0)
4355       FX2=Z2*BY(K0+1,L0+1,M0)+Z1*BY(K0,L0+1,M0)
4356       FFX1=X1*FX1+X2*FX2
4357       GX1=Z1*BY(K0,L0,M0+1)+Z2*BY(K0+1,L0,M0+1)
4358       GX2=Z2*BY(K0+1,L0+1,M0+1)+Z1*BY(K0,L0+1,M0+1)
4359       GGX1=X1*GX1+X2*GX2
4360       FY0=Y1*FFX1+Y2*GGX1
4361       FX1=Z1*BZ(K0,L0,M0)+Z2*BZ(K0+1,L0,M0)
4362       FX2=Z2*BZ(K0+1,L0+1,M0)+Z1*BZ(K0,L0+1,M0)
4363       FFX1=X1*FX1+X2*FX2
4364       GX1=Z1*BZ(K0,L0,M0+1)+Z2*BZ(K0+1,L0,M0+1)
4365       GX2=Z2*BZ(K0+1,L0+1,M0+1)+Z1*BZ(K0,L0+1,M0+1)
4366       GGX1=X1*GX1+X2*GX2
4367       FZ0=Y1*FFX1+Y2*GGX1
4368       RETURN
4369  100  CONTINUE
4370       IND=1
4371  1000 format(1x,'Attention!!! The point is out of range!!!')
4372 C      print 1000
4373       RETURN
4374       END
4375
4376 *************************************************
4377       SUBROUTINE FIZ(Z0,Z,DEL,KI,K0,Z1,Z2,NDZ)
4378 *************************************************
4379       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4380 ** CC      DIMENSION Z(NDZ)
4381       DIMENSION Z(10000)
4382       DDEL=Z0-Z(KI)
4383       KDEL=INT(DDEL/DEL)
4384       KJ=KI+KDEL
4385       K0 = NDZ - 1 ! CCCC
4386 *      if (k0.gt.81) print*,'ndz=',ndz
4387       IF (KJ.GT.NDZ) THEN ! CCC
4388          K0 = NDZ-1
4389          GO TO 100
4390       ENDIF
4391       DO 1 K=KJ,NDZ-1 ! CCC
4392       IF(Z0.LT.Z(K)) THEN
4393         K0 = K
4394         GO TO 100
4395       ENDIF
4396  1    CONTINUE
4397  100  CONTINUE
4398 *      print *,'K0=',K0,' Z0',z0, Z(K0), Z(K0+1),z2
4399       if (k0.gt.81) print*,'k0=',k0
4400       Z2=(Z0-Z(K0))/(Z(K0+1)-Z(K0))
4401       Z1=1.-Z2
4402 **      write(*,*) 'ko z1 z2', K0,Z1,Z2,' ki=',ki,' kj=',kj,' K=',K
4403 **      write(*,*)' NDZ Z(K0) Z(K0+1)',NDZ,Z(K0), Z(K0+1)
4404       RETURN
4405       END
4406
4407 ***************************************************
4408       SUBROUTINE FREG2(Z0,X0,Y0,FZ0,FX0,FY0,IND)
4409 **************************************************
4410       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4411 **      REAL *4 BXP,BYP,BZP
4412       COMMON/SDAT1/ZP(51),RAD(10),FI(33),DZP,DFI,DR,YY0,LPPZ,NR,NFI
4413       COMMON/SDAT2/BXP(51,10,33),BYP(51,10,33),BZP(51,10,33)
4414       COMMON/SDAT4/B(2,2,32)
4415       COMMON/REG3/ZPMAX,ZPMIN,RMAX,RMIN
4416 cc      COMMON/CONST/PI2,EPS
4417       KP=32+1
4418       LP=1
4419       MP=1
4420       YY0=0.3
4421       EPS=0.1D-6
4422       PI2=0.6283185E+01
4423       R0=DSQRT((X0-YY0)**2+Y0**2)
4424 c       write (*,*)'ro=',R0
4425       IF(Z0.LT.ZPMIN.OR.Z0.GT.ZPMAX)GO TO 100
4426       IF(R0.LT.RMIN.OR.R0.GT.RMAX)GO TO 100
4427       IF(R0.LE.DR)GO TO 3000
4428       CALL FIZ(Z0,ZP,DZP,KP,K0,Z1,Z2,51)
4429       CALL FIZ(R0,RAD,DR,LP,L0,X1,X2,10)
4430 **      print *,' r0=',r0,' rad=',rad,' dr=',dr,' lp=',lp,' l0=',l0,
4431 **     &     ' x1=',x1,' x2=',x2
4432       FI0=DACOS((X0-YY0)/R0)
4433       IF(Y0.LT.0.D+0)FI0=PI2-FI0
4434       CALL FIZ(FI0,FI,DFI,MP,M0,Y1,Y2,32)
4435 **      print *,' Apres FIZ',' k0=',k0,' l0=',l0,' m0=',m0
4436       FX1=Z1*BXP(K0,L0,M0)+Z2*BXP(K0+1,L0,M0)
4437       FX2=Z2*BXP(K0+1,L0+1,M0)+Z1*BXP(K0,L0+1,M0)
4438       FFX1=X1*FX1+X2*FX2
4439       GX1=Z1*BXP(K0,L0,M0+1)+Z2*BXP(K0+1,L0,M0+1)
4440       GX2=Z2*BXP(K0+1,L0+1,M0+1)+Z1*BXP(K0,L0+1,M0+1)
4441       GGX1=X1*GX1+X2*GX2
4442       FX0=Y1*FFX1+Y2*GGX1
4443       FX1=Z1*BYP(K0,L0,M0)+Z2*BYP(K0+1,L0,M0)
4444       FX2=Z2*BYP(K0+1,L0+1,M0)+Z1*BYP(K0,L0+1,M0)
4445       FFX1=X1*FX1+X2*FX2
4446       GX1=Z1*BYP(K0,L0,M0+1)+Z2*BYP(K0+1,L0,M0+1)
4447       GX2=Z2*BYP(K0+1,L0+1,M0+1)+Z1*BYP(K0,L0+1,M0+1)
4448       GGX1=X1*GX1+X2*GX2
4449       FY0=Y1*FFX1+Y2*GGX1
4450       FX1=Z1*BZP(K0,L0,M0)+Z2*BZP(K0+1,L0,M0)
4451 ** CCC      FX2=Z2*BZ(K0+1,L0+1,M0)+Z1*BZ(K0,L0+1,M0)
4452       FX2=Z2*BZP(K0+1,L0+1,M0)+Z1*BZP(K0,L0+1,M0)
4453       FFX1=X1*FX1+X2*FX2
4454       GX1=Z1*BZP(K0,L0,M0+1)+Z2*BZP(K0+1,L0,M0+1)
4455       GX2=Z2*BZP(K0+1,L0+1,M0+1)+Z1*BZP(K0,L0+1,M0+1)
4456       GGX1=X1*GX1+X2*GX2
4457       FZ0=Y1*FFX1+Y2*GGX1
4458       IND=0
4459       RETURN
4460  100  CONTINUE
4461       IND=2
4462  1000 format(1x,'Attention!!! The point is out of range!!!')
4463 C      print 1000
4464       RETURN
4465  3000 CONTINUE
4466       IF(R0.LT.EPS)GO TO 4000
4467       CALL FIZ(Z0,ZP,DZP,KP,K0,Z1,Z2,51)
4468       XX=X0-YY0
4469       FI0=DACOS(XX/R0)
4470       IF(Y0.LT.0.D+0)FI0=PI2-FI0
4471       CALL FIZ(FI0,FI,DFI,MP,M0,Y1,Y2,32)
4472       ALF2=B(1,1,M0)*XX+B(1,2,M0)*Y0
4473       ALF3=B(2,1,M0)*XX+B(2,2,M0)*Y0
4474       ALF1=1.-ALF2-ALF3
4475       FX1=ALF1*BXP(K0,1,1)+ALF2*BXP(K0,1,M0)+ALF3*BXP(K0,1,M0+1)
4476       FX2=ALF1*BXP(K0+1,1,1)+ALF2*BXP(K0+1,1,M0)+ALF3*BXP(K0+1,1,M0+1)
4477       FX0=Z1*FX1+Z2*FX2
4478       FX1=ALF1*BYP(K0,1,1)+ALF2*BYP(K0,1,M0)+ALF3*BYP(K0,1,M0+1)
4479       FX2=ALF1*BYP(K0+1,1,1)+ALF2*BYP(K0+1,1,M0)+ALF3*BYP(K0+1,1,M0+1)
4480       FY0=Z1*FX1+Z2*FX2
4481       FX1=ALF1*BZP(K0,1,1)+ALF2*BZP(K0,1,M0)+ALF3*BZP(K0,1,M0+1)
4482       FX2=ALF1*BZP(K0+1,1,1)+ALF2*BZP(K0+1,1,M0)+ALF3*BZP(K0+1,1,M0+1)
4483       FZ0=Z1*FX1+Z2*FX2
4484 c      write(*,*) 'R<Dr:B(1,1,m0) B(1,2,m0) B(2,1,m0) B(2,2,m0)',
4485 c     +B(1,1,M0),B(1,2,M0),B(2,1,M0),B(2,2,M0)
4486 c      write(*,*)'BX(K0,1,1) BX(K0,1,M0)','BX(K0,1,M0+1) BX(K0+1,1,1)'
4487 c     + ,'BX(K0+1,1,M0) BX(K0+1,1,M0+1)', BX(K0,1,1),BX(K0,1,M0) ,
4488 c     + BX(K0,1,M0+1),BX(K0+1,1,1),BX(K0+1,1,M0),BX(K0+1,1,M0+1)
4489 c      write(*,*)'By(K0,1,1) By(K0,1,M0)','By(K0,1,M0+1) By(K0+1,1,1)'
4490 c     + ,'By(K0+1,1,M0) By(K0+1,1,M0+1)', By(K0,1,1),By(K0,1,M0) ,
4491 c     + By(K0,1,M0+1),By(K0+1,1,1),By(K0+1,1,M0),By(K0+1,1,M0+1)
4492 ccc      write (*,*)'Bz(K0,1,1) Bz(K0,1,M0) Bz(K0,1,M0+1) Bz(K0+1,1,1)
4493   77  FORMAT(5x,E15.7,2x,E15.7)
4494 c      PRINT 70
4495 **   70 FORMAT(22hBz(K0,1,1) Bz(K0,1,M0))
4496 cc      PRINT 77 , BzP(K0,1,1),BzP(K0,1,M0)
4497 cc      PRINT 71
4498 **   71 FORMAT(26hBz(K0,1,M0+1) Bz(K0+1,1,1))
4499 cc     PRINT 77, BzP(K0,1,M0+1),BzP(K0+1,1,1)
4500 cc     PRINT 72
4501 **   72 FORMAT(29hBz(K0+1,1,M0) Bz(K0+1,1,M0+1))
4502 cc      PRINT 77 ,BzP(K0+1,1,M0),BzP(K0+1,1,M0+1)
4503 cc   77 FORMAT(5x,D15.7,5x,D15.7)
4504
4505
4506       IND=0
4507       RETURN
4508  4000 CONTINUE
4509       CALL FIZ(Z0,ZP,DZP,KP,K0,Z1,Z2,51)
4510       FX0=Z1*BXP(K0,1,1)+Z2*BXP(K0+1,1,1)
4511       FY0=Z1*BYP(K0,1,1)+Z2*BYP(K0+1,1,1)
4512       FZ0=Z1*BZP(K0,1,1)+Z2*BZP(K0+1,1,1)
4513 c      write(*,*) ' R<eps: Bx(k) Bx(k+1) By(k) By(k+1) Bz(k) Bz(k+1)',
4514 c     + BXP(K0,1,1),BXP(K0+1,1,1),BYP(K0,1,1),BYP(K0+1,1,1),BZP(K0,1,1),
4515 c     + BZP(K0+1,1,1)
4516       IND=0
4517       RETURN
4518       END
4519
4520 ***********************************************************************
4521
4522       SUBROUTINE RECO_GRKUTA (CHARGE,STEP,VECT,VOUT)
4523 C.
4524 C.    ******************************************************************
4525 C.    *                                                                *
4526 C.    *  Runge-Kutta method for tracking a particle through a magnetic *
4527 C.    *  field. Uses Nystroem algorithm (See Handbook Nat. Bur. of     *
4528 C.    *  Standards, procedure 25.5.20)                                 *
4529 C.    *                                                                *
4530 C.    *  Input parameters                                              *
4531 C.    *       CHARGE    Particle charge                                *
4532 C.    *       STEP      Step size                                      *
4533 C.    *       VECT      Initial co-ords,direction cosines,momentum     *
4534 C.    *  Output parameters                                             *
4535 C.    *       VOUT      Output co-ords,direction cosines,momentum      *
4536 C.    *  User routine called                                           *
4537 C.    *       CALL GUFLD(X,F)                                          *
4538 C.    *                                                                *
4539 C.    *    ==>Called by : <USER>, GUSWIM                               *
4540 C.    *       Authors    R.Brun, M.Hansroul  *********                 *
4541 C.    *                  V.Perevoztchikov (CUT STEP implementation)    *
4542 C.    *                                                                *
4543 C.    *                                                                *
4544 C.    ******************************************************************
4545 C.
4546       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4547
4548 **      REAL CHARGE, STEP, VECT(*), VOUT(*), F(4)
4549 **      REAL XYZT(3), XYZ(3), X, Y, Z, XT, YT, ZT
4550       DIMENSION VECT(*), VOUT(*), F(3)
4551       DIMENSION XYZT(3), XYZ(3)
4552       DIMENSION SECXS(4),SECYS(4),SECZS(4),HXP(3)
4553       EQUIVALENCE (X,XYZ(1)),(Y,XYZ(2)),(Z,XYZ(3)),
4554      +            (XT,XYZT(1)),(YT,XYZT(2)),(ZT,XYZT(3))
4555 *
4556       PARAMETER (MAXIT = 1992, MAXCUT = 11)
4557       PARAMETER (EC=2.9979251D-4,DLT=1D-4,DLT32=DLT/32)
4558       PARAMETER (ZERO=0, ONE=1, TWO=2, THREE=3)
4559       PARAMETER (THIRD=ONE/THREE, HALF=ONE/TWO)
4560       PARAMETER (PISQUA=.986960440109D+01)
4561       PARAMETER      (IX=1,IY=2,IZ=3,IPX=4,IPY=5,IPZ=6)
4562 *.
4563 *.    ------------------------------------------------------------------
4564 *.
4565 *             This constant is for units CM,GEV/C and KGAUSS
4566 *
4567       ITER = 0
4568       NCUT = 0
4569       DO 10 J=1,7
4570          VOUT(J)=VECT(J)
4571    10 CONTINUE
4572       PINV   = EC * CHARGE / VECT(7)
4573       TL = 0.
4574       H      = STEP
4575 *
4576 *
4577    20 REST  = STEP-TL
4578       IF (ABS(H).GT.ABS(REST)) H = REST
4579       CALL RECO_GUFLD(VOUT,F)
4580 *
4581 *             Start of integration
4582 *
4583       X      = VOUT(1)
4584       Y      = VOUT(2)
4585       Z      = VOUT(3)
4586       A      = VOUT(4)
4587       B      = VOUT(5)
4588       C      = VOUT(6)
4589 *
4590       H2     = HALF * H
4591       H4     = HALF * H2
4592       PH     = PINV * H
4593       PH2    = HALF * PH
4594       SECXS(1) = (B * F(3) - C * F(2)) * PH2
4595       SECYS(1) = (C * F(1) - A * F(3)) * PH2
4596       SECZS(1) = (A * F(2) - B * F(1)) * PH2
4597       ANG2 = (SECXS(1)**2 + SECYS(1)**2 + SECZS(1)**2)
4598       IF (ANG2.GT.PISQUA) GO TO 40
4599       DXT    = H2 * A + H4 * SECXS(1)
4600       DYT    = H2 * B + H4 * SECYS(1)
4601       DZT    = H2 * C + H4 * SECZS(1)
4602       XT     = X + DXT
4603       YT     = Y + DYT
4604       ZT     = Z + DZT
4605 *
4606 *              Second intermediate point
4607 *
4608       EST = ABS(DXT)+ABS(DYT)+ABS(DZT)
4609       IF (EST.GT.H) GO TO 30
4610
4611       CALL RECO_GUFLD(XYZT,F)
4612       AT     = A + SECXS(1)
4613       BT     = B + SECYS(1)
4614       CT     = C + SECZS(1)
4615 *
4616       SECXS(2) = (BT * F(3) - CT * F(2)) * PH2
4617       SECYS(2) = (CT * F(1) - AT * F(3)) * PH2
4618       SECZS(2) = (AT * F(2) - BT * F(1)) * PH2
4619       AT     = A + SECXS(2)
4620       BT     = B + SECYS(2)
4621       CT     = C + SECZS(2)
4622       SECXS(3) = (BT * F(3) - CT * F(2)) * PH2
4623       SECYS(3) = (CT * F(1) - AT * F(3)) * PH2
4624       SECZS(3) = (AT * F(2) - BT * F(1)) * PH2
4625       DXT    = H * (A + SECXS(3))
4626       DYT    = H * (B + SECYS(3))
4627       DZT    = H * (C + SECZS(3))
4628       XT     = X + DXT
4629       YT     = Y + DYT
4630       ZT     = Z + DZT
4631       AT     = A + TWO*SECXS(3)
4632       BT     = B + TWO*SECYS(3)
4633       CT     = C + TWO*SECZS(3)
4634 *
4635       EST = ABS(DXT)+ABS(DYT)+ABS(DZT)
4636       IF (EST.GT.2.*ABS(H)) GO TO 30
4637
4638       CALL RECO_GUFLD(XYZT,F)
4639 *
4640       Z      = Z + (C + (SECZS(1) + SECZS(2) + SECZS(3)) * THIRD) * H
4641       Y      = Y + (B + (SECYS(1) + SECYS(2) + SECYS(3)) * THIRD) * H
4642       X      = X + (A + (SECXS(1) + SECXS(2) + SECXS(3)) * THIRD) * H
4643 *
4644       SECXS(4) = (BT*F(3) - CT*F(2))* PH2
4645       SECYS(4) = (CT*F(1) - AT*F(3))* PH2
4646       SECZS(4) = (AT*F(2) - BT*F(1))* PH2
4647       A      = A+(SECXS(1)+SECXS(4)+TWO * (SECXS(2)+SECXS(3))) * THIRD
4648       B      = B+(SECYS(1)+SECYS(4)+TWO * (SECYS(2)+SECYS(3))) * THIRD
4649       C      = C+(SECZS(1)+SECZS(4)+TWO * (SECZS(2)+SECZS(3))) * THIRD
4650 *
4651       EST    = ABS(SECXS(1)+SECXS(4) - (SECXS(2)+SECXS(3)))
4652      ++        ABS(SECYS(1)+SECYS(4) - (SECYS(2)+SECYS(3)))
4653      ++        ABS(SECZS(1)+SECZS(4) - (SECZS(2)+SECZS(3)))
4654 *
4655       IF (EST.GT.DLT .AND. ABS(H).GT.1.E-4) GO TO 30
4656       ITER = ITER + 1
4657       NCUT = 0
4658 *               If too many iterations, go to HELIX
4659       IF (ITER.GT.MAXIT) GO TO 40
4660 *
4661       TL = TL + H
4662       IF (EST.LT.(DLT32)) THEN
4663          H = H*TWO
4664       ENDIF
4665       CBA    = ONE/ SQRT(A*A + B*B + C*C)
4666       VOUT(1) = X
4667       VOUT(2) = Y
4668       VOUT(3) = Z
4669       VOUT(4) = CBA*A
4670       VOUT(5) = CBA*B
4671       VOUT(6) = CBA*C
4672       REST = STEP - TL
4673       IF (STEP.LT.0.) REST = -REST
4674       IF (REST .GT. 1.E-5*ABS(STEP)) GO TO 20
4675 *
4676       GO TO 999
4677 *
4678 **              CUT STEP
4679    30 NCUT = NCUT + 1
4680 *               If too many cuts , go to HELIX
4681       IF (NCUT.GT.MAXCUT)       GO TO 40
4682       H = H*HALF
4683       GO TO 20
4684 *
4685 **              ANGLE TOO BIG, USE HELIX
4686    40 F1  = F(1)
4687       F2  = F(2)
4688       F3  = F(3)
4689       F4  = SQRT(F1**2+F2**2+F3**2)
4690       RHO = -F4*PINV
4691       TET = RHO * STEP
4692       IF(TET.NE.0.) THEN
4693          HNORM = ONE/F4
4694          F1 = F1*HNORM
4695          F2 = F2*HNORM
4696          F3 = F3*HNORM
4697 *
4698          HXP(1) = F2*VECT(IPZ) - F3*VECT(IPY)
4699          HXP(2) = F3*VECT(IPX) - F1*VECT(IPZ)
4700          HXP(3) = F1*VECT(IPY) - F2*VECT(IPX)
4701
4702          HP = F1*VECT(IPX) + F2*VECT(IPY) + F3*VECT(IPZ)
4703 *
4704          RHO1 = ONE/RHO
4705          SINT = SIN(TET)
4706          COST = TWO*SIN(HALF*TET)**2
4707 *
4708          G1 = SINT*RHO1
4709          G2 = COST*RHO1
4710          G3 = (TET-SINT) * HP*RHO1
4711          G4 = -COST
4712          G5 = SINT
4713          G6 = COST * HP
4714
4715          VOUT(IX) = VECT(IX) + (G1*VECT(IPX) + G2*HXP(1) + G3*F1)
4716          VOUT(IY) = VECT(IY) + (G1*VECT(IPY) + G2*HXP(2) + G3*F2)
4717          VOUT(IZ) = VECT(IZ) + (G1*VECT(IPZ) + G2*HXP(3) + G3*F3)
4718
4719          VOUT(IPX) = VECT(IPX) + (G4*VECT(IPX) + G5*HXP(1) + G6*F1)
4720          VOUT(IPY) = VECT(IPY) + (G4*VECT(IPY) + G5*HXP(2) + G6*F2)
4721          VOUT(IPZ) = VECT(IPZ) + (G4*VECT(IPZ) + G5*HXP(3) + G6*F3)
4722 *
4723       ELSE
4724          VOUT(IX) = VECT(IX) + STEP*VECT(IPX)
4725          VOUT(IY) = VECT(IY) + STEP*VECT(IPY)
4726          VOUT(IZ) = VECT(IZ) + STEP*VECT(IPZ)
4727 *
4728       ENDIF
4729 *
4730   999 END
4731
4732
4733 *******************************************************************
4734       SUBROUTINE RECO_GUFLDOLD1(X,B)
4735 C
4736 C    CONSTANT FIELD
4737 C
4738 C *** ROUTINE DESCRIBING THE MAGNETIC FIELD IN THE ALICE SETUP ***
4739 C *** NVE 14-NOV-1990 CERN GENEVA ***
4740 C
4741 C CALLED BY : GUFLD
4742 C ORIGIN    : NICK VAN EIJNDHOVEN
4743 C
4744 C Input :
4745 C -------
4746 C X = (X,Y,Z) coordinates in cm
4747 C
4748 C Output :
4749 C --------
4750 C B    = Magnetic field components (BX,BY,BZ) in KG
4751 C
4752
4753       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4754
4755       PARAMETER(NBSTATION=5)
4756 C
4757       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
4758
4759
4760 C
4761       DIMENSION X(3),B(3)
4762
4763       XT = X(2)
4764       X(2) = X(1)
4765       X(1) = XT
4766
4767       B(1) = 0.
4768       B(2) = 0.
4769       B(3) = 0.
4770
4771       IF (X(3).LT.(-1.*ZCOIL)) THEN
4772          B(3) = 2.
4773       ELSEIF ( X(3).LT.(-1.*ZMAGEND)) THEN
4774          B(1) = -10.
4775       ENDIF
4776
4777       BT = B(2)
4778       B(2) = B(1)
4779       B(1) = BT
4780
4781       XT = X(2)
4782       X(2) = X(1)
4783       X(1) = XT
4784 **      print *,' x =',X(1),X(2),X(3)
4785 **      print *,' B =',B(1),B(2),B(3)
4786
4787 C
4788
4789
4790  999  END
4791
4792
4793 *******************************************************************
4794       SUBROUTINE RECO_GUFLD(X,B)
4795 C
4796 C    Field map Mariana
4797 C
4798 C *** ROUTINE DESCRIBING THE MAGNETIC FIELD IN THE ALICE SETUP ***
4799 C *** NVE 14-NOV-1990 CERN GENEVA ***
4800 C
4801 C CALLED BY : GUFLD
4802 C ORIGIN    : NICK VAN EIJNDHOVEN
4803 C
4804 C Input :
4805 C -------
4806 C X = (X,Y,Z) coordinates in cm
4807 C
4808 C Output :
4809 C --------
4810 C B    = Magnetic field components (BX,BY,BZ) in KG
4811 C
4812
4813       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4814 C
4815
4816 C --- Common containing magnetic field map data
4817       REAL DZ,DX,DY,UDX,UDY,UDZ
4818      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
4819      $,BV
4820       INTEGER NX,NY,NZ
4821
4822       PARAMETER(MAXFLD=250000)
4823       COMMON /SCXMFD/ NX,NY,NZ,DZ,DX,DY,UDX,UDY,UDZ
4824      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
4825      $,BV(MAXFLD)
4826 C
4827
4828 C
4829       DIMENSION X(3),B(3)
4830       DOUBLE PRECISION ONE, RATX, RATY, RATZ, HIX, HIY, HIZ
4831      $,  RATX1, RATY1, RATZ1
4832      $,  BHYHZ, BHYLZ, BLYHZ, BLYLZ, BHZ, BLZ
4833      $,  XL(3)
4834
4835       PARAMETER (ONE=1)
4836
4837       EXTERNAL BX,BY,BZ
4838
4839       XT = X(2)
4840       X(2) = X(1)
4841       X(1) = XT
4842
4843
4844       ISXFMAP = 3
4845
4846 **      BX(JX,JY,JZ)=BV(3*((JZ-1)*(NX*NY)+(JY-1)*NX+(JX-1))+1)
4847 **      BY(JX,JY,JZ)=BV(3*((JZ-1)*(NX*NY)+(JY-1)*NX+(JX-1))+2)
4848 **      BZ(JX,JY,JZ)=BV(3*((JZ-1)*(NX*NY)+(JY-1)*NX+(JX-1))+3)
4849
4850
4851
4852 *
4853 * --- Act accordingly to ISXFMAP
4854 *
4855       IF(ISXFMAP.EQ.1) THEN
4856          IF (ABS(X(3)) .LT. 700.
4857      +      .AND. X(1)**2+(X(2)+30.)**2 .LT. 560.**2 ) THEN
4858             B(1)=0.
4859             B(2)=0.
4860             B(3)=2.
4861          ELSE IF (X(3) .GE. 725. .AND. X(3) .LT. 1225.) THEN
4862             DZ=ABS(975.-X(3))/100.
4863             B(1)=(1.-0.1*DZ*DZ)*7.0
4864             B(2)=0.
4865             B(3)=0.
4866          ELSE
4867             B(1)=0.
4868             B(2)=0.
4869             B(3)=0.
4870          ENDIF
4871       ELSE IF(ISXFMAP.LE.3) THEN
4872          IF (-700.LT.X(3).AND.X(3).LT.ZMBEG
4873      +      .AND. X(1)**2+(X(2)+30.)**2 .LT. 560.**2 ) THEN
4874             B(1)=0.
4875             B(2)=0.
4876             B(3)=0.
4877          ELSE IF ((X(3) .GE. ZMBEG .AND. X(3) .LT. ZMEND) .AND.
4878      +            (XMBEG.LE.ABS(X(1)).AND.ABS(X(1)).LT.XMEND) .AND.
4879      +            (YMBEG.LE.ABS(X(2)).AND.ABS(X(2)).LT.YMEND)) THEN
4880
4881
4882
4883 C --- find the position in the grid ---
4884
4885            XL(1)=ABS(X(1))-XMBEG
4886            XL(2)=ABS(X(2))-YMBEG
4887            XL(3)=X(3)-ZMBEG
4888
4889 C --- Start with X
4890
4891            HIX=XL(1)*UDX
4892            RATX=HIX-AINT(HIX)
4893            IX=HIX+1
4894
4895            HIY=XL(2)*UDY
4896            RATY=HIY-AINT(HIY)
4897            IY=HIY+1
4898
4899            HIZ=XL(3)*UDZ
4900            RATZ=HIZ-AINT(HIZ)
4901            IZ=HIZ+1
4902
4903            IF(ISXFMAP.EQ.2) THEN
4904 * ... Simple interpolation
4905
4906               B(1) = BX(IX,IY,IZ)*(ONE-RATX) + BX(IX+1,IY+1,IZ+1)*RATX
4907               B(2) = BY(IX,IY,IZ)*(ONE-RATY) + BY(IX+1,IY+1,IZ+1)*RATY
4908               B(3) = BZ(IX,IY,IZ)*(ONE-RATZ) + BZ(IX+1,IY+1,IZ+1)*RATZ
4909            ELSE IF(ISXFMAP.EQ.3) THEN
4910 * ... more complicated interpolation
4911               RATX1=ONE-RATX
4912               RATY1=ONE-RATY
4913               RATZ1=ONE-RATZ
4914 **              print *,' bx by bz', BX(IX  ,IY+1,IZ+1),BY(IX  ,IY+1,IZ+1)
4915 **     &        , BZ(IX  ,IY+1,IZ+1)
4916               BHYHZ = BX(IX  ,IY+1,IZ+1)*RATX1+BX(IX+1,IY+1,IZ+1)*RATX
4917               BHYLZ = BX(IX  ,IY+1,IZ  )*RATX1+BX(IX+1,IY+1,IZ  )*RATX
4918               BLYHZ = BX(IX  ,IY  ,IZ+1)*RATX1+BX(IX+1,IY  ,IZ+1)*RATX
4919               BLYLZ = BX(IX  ,IY  ,IZ  )*RATX1+BX(IX+1,IY  ,IZ  )*RATX
4920               BHZ   = BLYHZ             *RATY1+BHYHZ             *RATY
4921               BLZ   = BLYLZ             *RATY1+BHYLZ             *RATY
4922               B(1)  = BLZ               *RATZ1+BHZ               *RATZ
4923 *
4924               BHYHZ = BY(IX  ,IY+1,IZ+1)*RATX1+BY(IX+1,IY+1,IZ+1)*RATX
4925               BHYLZ = BY(IX  ,IY+1,IZ  )*RATX1+BY(IX+1,IY+1,IZ  )*RATX
4926               BLYHZ = BY(IX  ,IY  ,IZ+1)*RATX1+BY(IX+1,IY  ,IZ+1)*RATX
4927               BLYLZ = BY(IX  ,IY  ,IZ  )*RATX1+BY(IX+1,IY  ,IZ  )*RATX
4928               BHZ   = BLYHZ             *RATY1+BHYHZ             *RATY
4929               BLZ   = BLYLZ             *RATY1+BHYLZ             *RATY
4930               B(2)  = BLZ               *RATZ1+BHZ               *RATZ
4931 *
4932               BHYHZ = BZ(IX  ,IY+1,IZ+1)*RATX1+BZ(IX+1,IY+1,IZ+1)*RATX
4933               BHYLZ = BZ(IX  ,IY+1,IZ  )*RATX1+BZ(IX+1,IY+1,IZ  )*RATX
4934               BLYHZ = BZ(IX  ,IY  ,IZ+1)*RATX1+BZ(IX+1,IY  ,IZ+1)*RATX
4935               BLYLZ = BZ(IX  ,IY  ,IZ  )*RATX1+BZ(IX+1,IY  ,IZ  )*RATX
4936               BHZ   = BLYHZ             *RATY1+BHYHZ             *RATY
4937               BLZ   = BLYLZ             *RATY1+BHYLZ             *RATY
4938               B(3)  = BLZ               *RATZ1+BHZ               *RATZ
4939 *
4940            ENDIF
4941 * ... use the dipole symmetry
4942
4943            IF (X(1)*X(2).LT.0) B(2)=-B(2)
4944            IF (X(1).LT.0) B(3)=-B(3)
4945
4946 *
4947
4948       ELSE
4949
4950            B(1)=0.
4951            B(2)=0.
4952            B(3)=0.
4953
4954       ENDIF ! z-coord for m.f.
4955
4956       ENDIF ! endif ISXFMAP
4957
4958       SXMAGN = 1.
4959       SXMGMX = 20.
4960  12   B(1)=B(1)*SXMAGN
4961       B(2)=B(2)*SXMAGN
4962       B(3)=B(3)*SXMAGN
4963       BTOT=SQRT(B(1)**2+B(2)**2+B(3)**2)
4964       IF(BTOT.GT.SXMGMX) THEN
4965          PRINT 10100, BTOT,SXMGMX
4966 10100    FORMAT(' *GUFLD* Field ',G10.4,' larger than max ',G10.4)
4967       ENDIF
4968
4969
4970       BT = B(2)
4971       B(2) = B(1)
4972       B(1) = BT
4973
4974       XT = X(2)
4975       X(2) = X(1)
4976       X(1) = XT
4977
4978 C
4979
4980       RETURN
4981       END
4982
4983
4984 *******************************************
4985       DOUBLE PRECISION FUNCTION BX(JX,JY,JZ)
4986
4987       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
4988
4989 C --- Common containing magnetic field map data
4990       REAL DZ,DX,DY,UDX,UDY,UDZ
4991      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
4992      $,BV
4993       INTEGER NX,NY,NZ
4994
4995       PARAMETER(MAXFLD=250000)
4996       COMMON /SCXMFD/ NX,NY,NZ,DZ,DX,DY,UDX,UDY,UDZ
4997      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
4998      $,BV(MAXFLD)
4999
5000       BX=BV(3*((JZ-1)*(NX*NY)+(JY-1)*NX+(JX-1))+1)
5001
5002       END
5003
5004 *******************************************
5005        DOUBLE PRECISION FUNCTION BY(JX,JY,JZ)
5006
5007       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
5008
5009 C --- Common containing magnetic field map data
5010       REAL DZ,DX,DY,UDX,UDY,UDZ
5011      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
5012      $,BV
5013       INTEGER NX,NY,NZ
5014
5015       PARAMETER(MAXFLD=250000)
5016       COMMON /SCXMFD/ NX,NY,NZ,DZ,DX,DY,UDX,UDY,UDZ
5017      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
5018      $,BV(MAXFLD)
5019
5020       BY=BV(3*((JZ-1)*(NX*NY)+(JY-1)*NX+(JX-1))+2)
5021
5022       END
5023
5024 *******************************************
5025       DOUBLE PRECISION FUNCTION BZ(JX,JY,JZ)
5026
5027       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
5028
5029 C --- Common containing magnetic field map data
5030       REAL DZ,DX,DY,UDX,UDY,UDZ
5031      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
5032      $,BV
5033       INTEGER NX,NY,NZ
5034
5035       PARAMETER(MAXFLD=250000)
5036       COMMON /SCXMFD/ NX,NY,NZ,DZ,DX,DY,UDX,UDY,UDZ
5037      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
5038      $,BV(MAXFLD)
5039
5040       BZ=BV(3*((JZ-1)*(NX*NY)+(JY-1)*NX+(JX-1))+3)
5041
5042       END
5043
5044 ***********************************************************************
5045       SUBROUTINE INITFIELD
5046
5047 C
5048 C    Marianna
5049 C
5050 C *** INITIALISATION OF THE FIELD MAP ***
5051 C *** FCA 24-AUG-1998 CERN GENEVA ***
5052 C
5053 C CALLED BY : GALICE
5054 C ORIGIN    : NICK VAN EIJNDHOVEN
5055 C
5056       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
5057
5058
5059 C --- Common containing magnetic field map data
5060       REAL DZ,DX,DY,UDX,UDY,UDZ
5061      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
5062      $,BV
5063       INTEGER NX,NY,NZ
5064
5065       PARAMETER(MAXFLD=250000)
5066       COMMON /SCXMFD/ NX,NY,NZ,DZ,DX,DY,UDX,UDY,UDZ
5067      $,XMBEG,YMBEG,ZMBEG,XMEND,YMEND,ZMEND
5068      $,BV(MAXFLD)
5069
5070       ISXFMAP = 3
5071
5072       IF(ISXFMAP.EQ.1) THEN
5073 * ... constant field, nothing to do
5074       ELSE IF(ISXFMAP.LE.3) THEN
5075 * ... constant mesh field
5076          PRINT 10000, ISXFMAP
5077 10000    FORMAT(' *SXFMAP* Magnetic field map flag: ',I5
5078      $        ,'; Reading magnetic field map data ')
5079 *
5080          OPEN(77,FILE='/home/morsch/AliRoot/V3.02/data/field01.dat',
5081      $        FORM='FORMATTED',STATUS='OLD')
5082          READ(77,*) NX,NY,NZ,DX,DY,DZ,XMBEG,YMBEG,ZMBEG
5083          PRINT*,'NX,NY,NZ,DX,DY,DZ,XMBEG,YMBEG,ZMBEG',
5084      $   NX,NY,NZ,DX,DY,DZ,XMBEG,YMBEG,ZMBEG
5085          IF(3*NX*NY*NZ.GT.MAXFLD) THEN
5086             WRITE(6,10100) 3*NX*NY*NZ,MAXFLD
5087             STOP 'Increase MAXFLD'
5088          ENDIF
5089          UDX=1/DX
5090          UDY=1/DY
5091          UDZ=1/DZ
5092          XMEND=XMBEG+(NX-1)*DX
5093          YMEND=YMBEG+(NY-1)*DY
5094          ZMEND=ZMBEG+(NZ-1)*DZ
5095          DO IZ=1,NZ
5096             IPZ=3*(IZ-1)*(NX*NY)
5097             DO IY=1,NY
5098                IPY=IPZ+3*(IY-1)*NX
5099                DO IX=1,NX
5100                   IPX=IPY+3*(IX-1)
5101                   READ(77,*) BV(IPX+3),BV(IPX+2),BV(IPX+1)
5102                ENDDO
5103             ENDDO
5104          ENDDO
5105          CLOSE(77)
5106       ENDIF                     ! endif ISXFMAP
5107 *
5108 10100 FORMAT('*** SXFMAP: Need ',I7,' have ',I7)
5109       END
5110
5111 ****************************************
5112       SUBROUTINE RANNOR (A,B)
5113 ****************************************
5114 C
5115 C CERN PROGLIB# V100    RANNOR          .VERSION KERNFOR  4.18  880425
5116 C ORIG. 18/10/77
5117 C
5118       Y = RNDM()
5119       IF (Y.EQ.0.)  Y = RNDM()
5120       Z = RNDM()
5121
5122       X = 6.283185*Z
5123       R = SQRT (-2.0*LOG(Y))
5124       A = R*SIN (X)
5125       B = R*COS (X)
5126       RETURN
5127       END
5128 ************************************************************************
5129       SUBROUTINE OLDFCNFIT(NPAR,GRAD,FVAL,XVAL,IFLAG,FUTIL)
5130 ************************************************************************
5131 *    Calcule FVAL: la fonction minimisee par MINUIT
5132 *    with constant magnetic Field
5133 *
5134 ************************************************************************
5135
5136       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
5137
5138       PARAMETER(NPLANE=10)
5139
5140       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
5141      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
5142
5143       COMMON/MEAS/LPLANE(NPLANE),XMP(NPLANE),YMP(NPLANE)
5144
5145       COMMON/FCNOUT/PXZEA,ALAMEA,PHIEA,XEA,YEA,NPLU,CHI2
5146
5147       DIMENSION GRAD(*),XVAL(*),AMS(500),DISTAZ(500)
5148
5149       DIMENSION XP(NPLANE),YP(NPLANE),
5150      &          COV(NPLANE,NPLANE),AP(NPLANE),COVY(NPLANE,NPLANE)
5151       DIMENSION VECT(7),VOUT(7)
5152
5153       XV = XVAL(4)
5154       YV = XVAL(5)
5155
5156       ASIGN = 1.
5157       IF (XVAL(1).LT.0.) ASIGN = -1.
5158       PHI  = XVAL(2)
5159       ALAM = XVAL(3)
5160       PXZ = DABS(1./XVAL(1))
5161
5162       PX = PXZ*DSIN(PHI)
5163       PY = PXZ*DTAN(ALAM)
5164       PZ = PXZ*DCOS(PHI)
5165       PTOT = PXZ/DCOS(ALAM)
5166       TTHET = DSQRT(DTAN(ALAM)**2+DSIN(PHI)**2)/DCOS(PHI)
5167       THET = DATAN(TTHET)
5168       PT = DSQRT(PX**2+PY**2)
5169
5170       RL3 = ASIGN*PT / (0.299792458D-3 * BL3)
5171       ALPHA = DATAN2(PY,PX)
5172       XC = XV+RL3*DSIN(ALPHA)
5173       YC = YV-RL3*DCOS(ALPHA)
5174
5175       A12 = 0.
5176       NTMAX = 0
5177
5178       ZEA = ZABS
5179       XEA = XV
5180       YEA = YV
5181       PXEA = PX
5182       PYEA = PY
5183       PHIEA = PHI
5184       PXZEA = ASIGN*PXZ
5185       ALAMEA = ALAM
5186 * 1er plan
5187       ANGDEV = (ZPLANEP(1)-ZEA)*TTHET/RL3
5188       XP(1) = XC+RL3*DSIN(ANGDEV-ALPHA)
5189       YP(1) = YC+RL3*DCOS(ANGDEV-ALPHA)
5190       AL   = THICK/ DCOS(THET)
5191       AP(1)  = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5192 * 2eme plan
5193       ANGDEV = (ZPLANEP(2)-ZEA)*TTHET/RL3
5194       XP(2) = XC+RL3*DSIN(ANGDEV-ALPHA)
5195       YP(2) = YC+RL3*DCOS(ANGDEV-ALPHA)
5196       AL   = THICK/ DCOS(THET)
5197       AP(2) = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5198 * 3eme plan
5199       ANGDEV = (ZPLANEP(3)-ZEA)*TTHET/RL3
5200       XP(3) = XC+RL3*DSIN(ANGDEV-ALPHA)
5201       YP(3) = YC+RL3*DCOS(ANGDEV-ALPHA)
5202       AL   = THICK/ DCOS(THET)
5203       AP(3)  = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5204 * 4eme plan
5205       ANGDEV = (ZPLANEP(4)-ZEA)*TTHET/RL3
5206       XP(4) = XC+RL3*DSIN(ANGDEV-ALPHA)
5207       YP(4) = YC+RL3*DCOS(ANGDEV-ALPHA)
5208       AL   = THICK/ DCOS(THET)
5209       AP(4) = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5210 * Fin de L3
5211       ANGDEV = (700.D0-ZEA)*TTHET/RL3
5212       XPL3 = XC+RL3*DSIN(ANGDEV-ALPHA)
5213       YPL3 = YC+RL3*DCOS(ANGDEV-ALPHA)
5214       PX = PT*DCOS(ANGDEV-ALPHA)
5215       PY = -PT*DSIN(ANGDEV-ALPHA)
5216       PHIC = DATAN2(PY,PX)
5217       CX = DSIN(THET)*DCOS(PHIC)
5218       CY = DSIN(THET)*DSIN(PHIC)
5219       CZ = DCOS(THET)
5220 * Entree du dipole
5221       VECT(1) = XPL3+(ZMAGS-700.)*CX/CZ
5222       VECT(2) = YPL3+(ZMAGS-700.)*CY/CZ
5223       VECT(3) = ZMAGS
5224       VECT(4) = CX
5225       VECT(5) = CY
5226       VECT(6) = CZ
5227       VECT(7) = PTOT
5228
5229       PXZ  = PTOT*DSQRT(VECT(4)**2+VECT(6)**2)
5230       RDIP = ASIGN*PXZ / (0.299792458D-3 * B0)
5231       PHI1 = DATAN2(VECT(4),VECT(6))
5232       XC   = VECT(1)+RDIP*DCOS(PHI1)
5233       ZC   = VECT(3)-RDIP*DSIN(PHI1)
5234
5235       IF (DABS((ZMAGE-ZPLANEP(5))/RDIP).GE.1.D0) RETURN ! Particule boucle dans le champ
5236       XP(5) = XC-ASIGN*DSQRT(RDIP**2-(ZPLANEP(5)-ZC)**2)
5237       YP(5) = VECT(2)+(ZPLANEP(5)-ZMAGS)*VECT(5)/VECT(6)
5238       CX = (ZPLANEP(5)-ZC)/RDIP
5239       CY = VECT(5)
5240       CZ = DABS((XP(5)-XC)/RDIP)
5241       THET = DATAN2(DSQRT(CX**2+CY**2),CZ)
5242       AL   = THICK/ DCOS(THET)
5243       AP(5) = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5244
5245       IF (DABS((ZMAGE-ZPLANEP(6))/RDIP).GE.1.D0) RETURN ! Particule boucle dans le champ
5246       XP(6) = XC-ASIGN*DSQRT(RDIP**2-(ZPLANEP(6)-ZC)**2)
5247       YP(6) = VECT(2)+(ZPLANEP(6)-ZMAGS)*VECT(5)/VECT(6)
5248       CX = (ZPLANEP(6)-ZC)/RDIP
5249       CY = VECT(5)
5250       CZ = DABS((XP(6)-XC)/RDIP)
5251       THET = DATAN2(DSQRT(CX**2+CY**2),CZ)
5252       AL   = THICK/ DCOS(THET)
5253       AP(6) = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5254
5255
5256       IF (DABS((ZMAGE-ZC)/RDIP).GE.1.D0) RETURN ! Particule boucle dans le champ
5257       VOUT(1) = XC-ASIGN*DSQRT(RDIP**2-(ZMAGE-ZC)**2)
5258       VOUT(2) = VECT(2)+(ZMAGE-ZMAGS)*VECT(5)/VECT(6)
5259       VOUT(3) = ZMAGE
5260       VOUT(4) = (ZMAGE-ZC)/RDIP
5261       VOUT(5) = VECT(5)
5262       VOUT(6) = DABS((VOUT(1)-XC)/RDIP)
5263       VOUT(7) = PTOT
5264
5265       DO IV = 1,7
5266          VECT(IV) = VOUT(IV)
5267       ENDDO
5268
5269 * 7eme plan
5270       THET = DATAN2(DSQRT(VECT(4)**2+VECT(5)**2),VECT(6))
5271       XP(7) = VECT(1)+(ZPLANEP(7)-ZMAGE)*VECT(4)/VECT(6)
5272       YP(7) = VECT(2)+(ZPLANEP(7)-ZMAGE)*VECT(5)/VECT(6)
5273       AL   = THICK/ DCOS(THET)
5274       AP(7)  = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5275 * 8eme plan
5276       XP(8) = XP(7)+(ZPLANEP(8)-ZPLANEP(7))*VECT(4)/VECT(6)
5277       YP(8) = YP(7)+(ZPLANEP(8)-ZPLANEP(7))*VECT(5)/VECT(6)
5278       AL   = THICK/ DCOS(THET)
5279       AP(8)  = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5280
5281 * 9eme plan
5282       XP(9) = XP(8)+(ZPLANEP(9)-ZPLANEP(8))*VECT(4)/VECT(6)
5283       YP(9) = YP(8)+(ZPLANEP(9)-ZPLANEP(8))*VECT(5)/VECT(6)
5284       AL   = THICK/ DCOS(THET)
5285       AP(9)  = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5286
5287 * 10eme plan
5288       XP(10) = XP(9)+(ZPLANEP(10)-ZPLANEP(9))*VECT(4)/VECT(6)
5289       YP(10) = YP(9)+(ZPLANEP(10)-ZPLANEP(9))*VECT(5)/VECT(6)
5290       AL   = THICK/ DCOS(THET)
5291       AP(10)  = (0.0136D0/PTOT) * DSQRT(AL) * (1 + 0.038D0*DLOG(AL))
5292
5293 ** Matrice de covariance
5294       I = 0
5295       DO II = 1,NPLANE
5296         IF (LPLANE(II).EQ.1) THEN
5297         I = I + 1
5298 *        I = II
5299         J = I - 1
5300         DO JJ = II, NPLANE
5301            IF (LPLANE(JJ).EQ.1) THEN
5302            J = J + 1
5303 *           J = JJ
5304            COV (I,J) = 0.0D0
5305            COV (J,I) = A12
5306            IF (I .EQ. J) THEN
5307                  COV(J,I) =COV(J,I) + XPREC**2
5308            ENDIF
5309
5310 *           IF (I .EQ. 10 .AND. J .EQ. 10) PRINT *,'10 10   ',COV(J,I)
5311            DO L = 1,NTMAX
5312               COV(J,I) = COV(J,I)
5313      &  +  (ZPLANEP(II) + DISTAZ(L))*(ZPLANEP(JJ) + DISTAZ(L))*AMS(L)**2
5314            ENDDO
5315            DO K = 1, II-1
5316               COV(J,I) = COV(J,I)
5317      &  + (ZPLANEP(II)-ZPLANEP(K))*(ZPLANEP(JJ)-ZPLANEP(K))*AP(K)**2
5318 *              IF (I .EQ. 10 .AND. J .EQ. 10) PRINT *,'10 10   ',COV(J,I)
5319            ENDDO
5320            COVY(I,J) = 0.0D0
5321            COVY(J,I) = COV(J,I)
5322            IF (I .EQ. J) THEN
5323                  COVY(J,I) = COVY(J,I) - XPREC**2 + YPREC**2
5324            ENDIF
5325         ENDIF
5326         ENDDO
5327         ENDIF
5328       ENDDO
5329
5330 *  Inversion des matrices de covariance
5331       NPLU = I
5332
5333       IFAIL = 0
5334       CALL DSINV(NPLU, COV, NPLANE, IFAIL)
5335 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
5336       IF (IFAIL .NE. 0) STOP 'ERROR'
5337       IFAIL = 0
5338       CALL DSINV(NPLU, COVY, NPLANE, IFAIL)
5339 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
5340       IF (IFAIL .NE. 0) STOP 'ERROR'
5341 *      PRINT *,' COVARIANCE MATRIX AFTER'
5342 *      DO I = 1, NPLANE
5343 *         PRINT *,(COV(J,I),J=1,NPLANE)
5344 *      ENDDO
5345
5346 ** Calcul de FVAL ou CHI2
5347       FVAL = 0.0D0
5348       I = 0
5349       DO II = 1,NPLANE
5350         IF (LPLANE(II).EQ.1) THEN
5351         I = I+1
5352 *        I = II
5353         J = 0
5354         DO JJ = 1,NPLANE
5355            IF (LPLANE(JJ).EQ.1) THEN
5356               J = J+1
5357 *             J = JJ
5358               FVAL = FVAL + COV(J,I)*(XMP(II)-XP(II))*(XMP(JJ)-XP(JJ))
5359               FVAL = FVAL + COVY(J,I)*(YMP(II)-YP(II))
5360      &                               *(YMP(JJ)-YP(JJ))
5361 **             IF (JJ.EQ.II) THEN
5362 **                 FVAL = FVAL + (XMP(II)-XP(II))*(XMP(JJ)-XP(JJ))/XPREC**2
5363 **                 FVAL = FVAL + (YMP(II)-YP(II))
5364 **     &                               *(YMP(JJ)-YP(JJ))/YPREC**2
5365 **             ENDIF
5366            ENDIF
5367         ENDDO
5368         ENDIF
5369       ENDDO
5370       CHI2 = FVAL
5371          print *,' fcnfit pxz tphi talam xvert yvert chi2',
5372      &       PXZEA,PHIEA,ALAMEA,
5373      &       XEA,YEA,CHI2/FLOAT(2*NPLU-5)
5374
5375  1000 FORMAT(I5,7F12.6)
5376
5377       RETURN
5378       END
5379
5380 *
5381 * $Id$
5382 *
5383 * $Log$
5384 * Revision 1.5  2000/06/15 07:58:49  morsch
5385 * Code from MUON-dev joined
5386 *
5387 * Revision 1.4.4.2  2000/04/26 15:48:37  morsch
5388 * Some routines from obsolete algo.F are needed by reco_muon.F and have been
5389 * copied there.
5390 *
5391 * Revision 1.4.4.1  2000/01/12 16:00:55  morsch
5392 * New version of MUON code
5393 *
5394 * Revision 1.1.1.1  1995/10/24 10:21:41  cernlib
5395 * Geant
5396 *
5397 *
5398 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
5399 *-- Author :
5400       SUBROUTINE RECO_GHELIX (CHARGE, STEP, VECT, VOUT)
5401 C.
5402 C.    ******************************************************************
5403 C.    *                                                                *
5404 C.    *  Performs the tracking of one step in a magnetic field         *
5405 C.    *  The trajectory is assumed to be a helix in a constant field   *
5406 C.    *  taken at the mid point of the step.                           *
5407 C.    *  Parameters:                                                   *
5408 C.    *   input                                                        *
5409 C.    *     STEP =arc length of the step asked                         *
5410 C.    *     VECT =input vector (position,direction cos and momentum)   *
5411 C.    *     CHARGE=  electric charge of the particle                   *
5412 C.    *   output                                                       *
5413 C.    *     VOUT = same as VECT after completion of the step           *
5414 C.    *                                                                *
5415 C.    *    ==>Called by : <USER>, GUSWIM                               *
5416 C.    *       Author    M.Hansroul  *********                          *
5417 C.    *       Modified  S.Egli, S.V.Levonian                           *
5418 C.    *       Modified  V.Perevoztchikov
5419 C.    *                                                                *
5420 C.    ******************************************************************
5421 C.
5422       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
5423
5424       DIMENSION      VECT(7),VOUT(7)
5425       DIMENSION      XYZ(3),H(4),HXP(3)
5426       PARAMETER      (IX=1,IY=2,IZ=3,IPX=4,IPY=5,IPZ=6,IPP=7)
5427       PARAMETER      (SIXTH = 1./6.)
5428       PARAMETER      (EC=2.9979251E-4)
5429 C.
5430 C.    ------------------------------------------------------------------
5431 C.
5432 C       units are kgauss,centimeters,gev/c
5433 C
5434       VOUT(IPP) = VECT(IPP)
5435       IF (CHARGE.EQ.0.)         GO TO 10
5436       XYZ(1)    = VECT(IX) + 0.5 * STEP * VECT(IPX)
5437       XYZ(2)    = VECT(IY) + 0.5 * STEP * VECT(IPY)
5438       XYZ(3)    = VECT(IZ) + 0.5 * STEP * VECT(IPZ)
5439 C
5440       CALL RECO_GUFLD (XYZ, H)
5441
5442       H2XY = H(1)**2 + H(2)**2
5443       H(4) = H(3)**2 + H2XY
5444       IF (H(4).LE.1.E-12)       GO TO 10
5445       IF (H2XY.LE.1.E-12*H(4))  THEN
5446          CALL RECO_GHELX3 (CHARGE*H(3), STEP, VECT, VOUT)
5447          GO TO 999
5448       ENDIF
5449       H(4) = SQRT(H(4))
5450       H(1) = H(1)/H(4)
5451       H(2) = H(2)/H(4)
5452       H(3) = H(3)/H(4)
5453       H(4) = H(4)*EC
5454 *
5455       HXP(1) = H(2)*VECT(IPZ) - H(3)*VECT(IPY)
5456       HXP(2) = H(3)*VECT(IPX) - H(1)*VECT(IPZ)
5457       HXP(3) = H(1)*VECT(IPY) - H(2)*VECT(IPX)
5458
5459       HP = H(1)*VECT(IPX) + H(2)*VECT(IPY) + H(3)*VECT(IPZ)
5460 *
5461       RHO = -CHARGE*H(4)/VECT(IPP)
5462       TET = RHO * STEP
5463       IF (ABS(TET).GT.0.15)     THEN
5464          SINT = SIN(TET)
5465          SINTT = (SINT/TET)
5466          TSINT = (TET-SINT)/TET
5467          COS1T = 2.*(SIN(0.5*TET))**2/TET
5468       ELSE
5469          TSINT = SIXTH*TET**2
5470          SINTT = (1. - TSINT)
5471          SINT = TET*SINTT
5472          COS1T = 0.5*TET
5473       ENDIF
5474 *
5475       F1 = STEP * SINTT
5476       F2 = STEP * COS1T
5477       F3 = STEP * TSINT * HP
5478       F4 = -TET*COS1T
5479       F5 = SINT
5480       F6 = TET * COS1T * HP
5481
5482       VOUT(IX) = VECT(IX) + (F1*VECT(IPX) + F2*HXP(1) + F3*H(1))
5483       VOUT(IY) = VECT(IY) + (F1*VECT(IPY) + F2*HXP(2) + F3*H(2))
5484       VOUT(IZ) = VECT(IZ) + (F1*VECT(IPZ) + F2*HXP(3) + F3*H(3))
5485
5486       VOUT(IPX) = VECT(IPX) + (F4*VECT(IPX) + F5*HXP(1) + F6*H(1))
5487       VOUT(IPY) = VECT(IPY) + (F4*VECT(IPY) + F5*HXP(2) + F6*H(2))
5488       VOUT(IPZ) = VECT(IPZ) + (F4*VECT(IPZ) + F5*HXP(3) + F6*H(3))
5489
5490       GO TO 999
5491
5492    10 CONTINUE
5493       DO 20 I   = 1,3
5494          VOUT(I) = VECT(I) + STEP * VECT(I+3)
5495          VOUT(I+3) = VECT(I+3)
5496    20 CONTINUE
5497 C
5498   999 END
5499
5500 *
5501 * $Id$
5502 *
5503 * $Log$
5504 * Revision 1.5  2000/06/15 07:58:49  morsch
5505 * Code from MUON-dev joined
5506 *
5507 * Revision 1.4.4.2  2000/04/26 15:48:37  morsch
5508 * Some routines from obsolete algo.F are needed by reco_muon.F and have been
5509 * copied there.
5510 *
5511 * Revision 1.4.4.1  2000/01/12 16:00:55  morsch
5512 * New version of MUON code
5513 *
5514 * Revision 1.1.1.1  1995/10/24 10:21:41  cernlib
5515 * Geant
5516 *
5517 *
5518
5519 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
5520 *-- Author :
5521       SUBROUTINE RECO_GHELX3 (FIELD, STEP, VECT, VOUT)
5522 C.
5523 C.    ******************************************************************
5524 C.    *                                                                *
5525 C.    *       Tracking routine in a constant field oriented            *
5526 C.    *       along axis 3                                             *
5527 C.    *       Tracking is performed with a conventional                *
5528 C.    *       helix step method                                        *
5529 C.    *                                                                *
5530 C.    *    ==>Called by : <USER>, GUSWIM                               *
5531 C.    *       Authors    R.Brun, M.Hansroul  *********                 *
5532 C     *       Rewritten  V.Perevoztchikov
5533 C.    *                                                                *
5534 C.    ******************************************************************
5535 C.
5536       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
5537
5538       DIMENSION      VECT(7),VOUT(7),HXP(3)
5539       PARAMETER      (IX=1,IY=2,IZ=3,IPX=4,IPY=5,IPZ=6,IPP=7)
5540       PARAMETER      (SIXTH = 1./6.)
5541       PARAMETER      (EC=2.9979251E-4)
5542 C.
5543 C.    ------------------------------------------------------------------
5544 C.
5545 C       units are kgauss,centimeters,gev/c
5546 C
5547       VOUT(IPP) = VECT(IPP)
5548       H4 = FIELD * EC
5549 *
5550       HXP(1) = - VECT(IPY)
5551       HXP(2) = + VECT(IPX)
5552
5553       HP = VECT(IPZ)
5554 *
5555       RHO = -H4/VECT(IPP)
5556       TET = RHO * STEP
5557       IF (ABS(TET).GT.0.15)     THEN
5558          SINT = SIN(TET)
5559          SINTT = (SINT/TET)
5560          TSINT = (TET-SINT)/TET
5561          COS1T = 2.*(SIN(0.5*TET))**2/TET
5562       ELSE
5563          TSINT = SIXTH*TET**2
5564          SINTT = (1. - TSINT)
5565          SINT = TET*SINTT
5566          COS1T = 0.5*TET
5567       ENDIF
5568 *
5569       F1 = STEP * SINTT
5570       F2 = STEP * COS1T
5571       F3 = STEP * TSINT * HP
5572       F4 = -TET*COS1T
5573       F5 = SINT
5574       F6 = TET * COS1T * HP
5575
5576       VOUT(IX) = VECT(IX) + (F1*VECT(IPX) + F2*HXP(1))
5577       VOUT(IY) = VECT(IY) + (F1*VECT(IPY) + F2*HXP(2))
5578       VOUT(IZ) = VECT(IZ) + (F1*VECT(IPZ) + F3)
5579
5580       VOUT(IPX) = VECT(IPX) + (F4*VECT(IPX) + F5*HXP(1))
5581       VOUT(IPY) = VECT(IPY) + (F4*VECT(IPY) + F5*HXP(2))
5582       VOUT(IPZ) = VECT(IPZ) + (F4*VECT(IPZ) + F6)
5583
5584 C
5585   999 END
5586
5587 ************************************************************************
5588       DOUBLE PRECISION FUNCTION RECOCHI2 (MPOS,MANG,XM,YM,ALAMM,APHIM,
5589      &     XC,YC,ALAMC,APHIC,PTOT,IZMES,NPLPL)
5590 C.
5591 C.    ******************************************************************
5592 C.    *   Calculate chi2 taking into account MSC                       *
5593 C.    *                                                                *
5594 C.    ******************************************************************
5595 C.
5596       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
5597       PARAMETER(NBSTATION=5,NPLANE=10)
5598
5599       COMMON/ZDEFIN/ZPLANE(NBSTATION),ZCOIL,ZMAGEND,DZ_PL(NBSTATION)
5600
5601       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
5602      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
5603 C
5604       DIMENSION MPOS(NBSTATION),MANG(NBSTATION),
5605      &    XM(NBSTATION),YM(NBSTATION),ALAMM(NBSTATION),APHIM(NBSTATION),
5606      &    XC(NBSTATION),YC(NBSTATION),ALAMC(NBSTATION),APHIC(NBSTATION),
5607      &    ALAMP(NBSTATION),APHIP(NBSTATION)
5608
5609       DIMENSION AP(NPLANE),IZMES(NBSTATION),IPLANE(NPLANE)
5610       DIMENSION COVX(NPLANE,NPLANE),COVY(NPLANE,NPLANE)
5611       DIMENSION XM1(NPLANE),YM1(NPLANE),XC1(NPLANE),YC1(NPLANE)
5612
5613
5614       ICH = 0
5615       NPLPL = 0
5616       DO IZ = 1,NBSTATION
5617           ICH = ICH + 1
5618           IPLANE(ICH) = 0
5619           AL   = THICK/(COS(ALAMC(IZ))*COS(APHIC(IZ)))
5620           AP(ICH) = (0.0136D0/PTOT)*DSQRT(AL)*(1.+0.038D0*DLOG(AL))
5621           IF (MPOS(IZ).EQ.1.AND.IZMES(IZ).EQ.1) THEN
5622              IPLANE(ICH) = 1
5623              XM1(ICH) = XM(IZ)
5624              YM1(ICH) = YM(IZ)
5625           ENDIF
5626           XC1(ICH) = XC(IZ)
5627           YC1(ICH) = YC(IZ)
5628
5629           ICH = ICH + 1
5630           IPLANE(ICH) = 0
5631           AP(ICH) = (0.0136D0/PTOT)*DSQRT(AL)*(1.+0.038D0*DLOG(AL))
5632           IF (MPOS(IZ).EQ.1.AND.IZMES(IZ).EQ.2) THEN
5633              IPLANE(ICH) = 1
5634              XM1(ICH) = XM(IZ)
5635              YM1(ICH) = YM(IZ)
5636           ENDIF
5637           IF (MANG(IZ).EQ.1) THEN
5638              IPLANE(ICH) = 1
5639              XM1(ICH) = XM(IZ) - DZ_PL(IZ) * TAN(APHIM(IZ))
5640              YM1(ICH) = YM(IZ) + DZ_PL(IZ)/COS(APHIM(IZ))*TAN(ALAMM(IZ))
5641           ENDIF
5642           XC1(ICH) = XC(IZ) - DZ_PL(IZ) * TAN(APHIC(IZ))
5643           YC1(ICH) = YC(IZ) + DZ_PL(IZ)/COS(APHIC(IZ))*TAN(ALAMC(IZ))
5644           IF (IPLANE(ICH).EQ.1) NPLPL = NPLPL+1
5645       ENDDO
5646
5647
5648
5649 ** Matrice de covariance X et Y
5650       I = 0
5651       DO II = 1,NPLANE
5652
5653         IF (IPLANE(II).EQ.1) THEN
5654            I = I + 1
5655
5656            J = I - 1
5657            DO JJ = II, NPLANE
5658               IF (IPLANE(JJ).EQ.1) THEN
5659                  J = J + 1
5660
5661                  COVX (I,J) = 0.
5662                  COVX (J,I) = 0.
5663                  IF (I .EQ. J) THEN
5664                     COVX(J,I) =COVX(J,I) + XPREC**2
5665                  ENDIF
5666
5667                  DO K = 1, II-1
5668                     COVX(J,I) = COVX(J,I)
5669      &                   +  (-ZPLANEP(II)+ZPLANEP(K))*
5670      &                   (-ZPLANEP(JJ)+ZPLANEP(K))*AP(K)**2
5671
5672                  ENDDO
5673                  COVY(I,J) = 0.
5674                  COVY(J,I) = COVX(J,I)
5675                  IF (I .EQ. J) THEN
5676                     COVY(J,I) = COVY(J,I) - XPREC**2 + YPREC**2
5677                  ENDIF
5678               ENDIF
5679            ENDDO
5680         ENDIF
5681       ENDDO
5682
5683       NPLUP = I
5684
5685
5686 *  Inversion des matrices de covariance
5687       IFAIL = 0
5688       CALL DSINV(NPLUP, COVX, NPLANE, IFAIL)
5689 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
5690       IF (IFAIL .NE. 0) STOP 'RECOCHI2 ERROR COVX'
5691
5692       IFAIL = 0
5693       CALL DSINV(NPLUP, COVY, NPLANE, IFAIL)
5694 **      IF (JFAIL.NE.0 .AND. IFAIL .NE. 0) STOP 'ERROR'
5695       IF (IFAIL .NE. 0) STOP 'RECOCHI2 ERROR COVY'
5696
5697 ** Calcul de FVAL ou CHI2
5698       FVAL = 0.
5699
5700       I = 0
5701       DO II = 1,NPLANE
5702         IF (IPLANE(II).EQ.1) THEN
5703            I = I+1
5704            J = 0
5705 **           print *,' II=',ii,' XM1,YM1 =',xm1(ii),ym1(ii),
5706 **     &          ' XC,YC =',xc1(ii),yc1(ii)
5707            DO JJ = 1,NPLANE
5708               IF (IPLANE(JJ).EQ.1) THEN
5709                  J = J+1
5710                  FVAL = FVAL + COVX(J,I)*(XM1(II)-XC1(II))
5711      &                *(XM1(JJ)-XC1(JJ))
5712                  FVAL = FVAL + COVY(J,I)*(YM1(II)-YC1(II))
5713      &                *(YM1(JJ)-YC1(JJ))
5714               ENDIF
5715            ENDDO
5716         ENDIF
5717       ENDDO
5718
5719       RECOCHI2 = FVAL
5720 **      print *,' recochi2 =',recochi2
5721
5722 C
5723       RETURN
5724       END
5725
5726 ************************************************************************
5727       SUBROUTINE RECO_SELECT(ISEL)
5728 ************************************************************************       *    ISEL(I) = 1 if track number I is OK, ISEL(I) = 0 otherwise
5729 ************************************************************************
5730       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
5731
5732       PARAMETER (NPLANE=10,NBCHAMBER=10,NTRMAX=500)
5733
5734       COMMON/DEBEVT/IDEBUG
5735
5736       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
5737      &             ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
5738
5739       COMMON/TRACKFOUT/IEVOUT,NTREVT,JJOUT(NBCHAMBER,NTRMAX),
5740      &               ISTAT(NTRMAX),PXZOUT(NTRMAX),TPHIOUT(NTRMAX),
5741      &               TALAMOUT(NTRMAX),XVERTOUT(NTRMAX),YVERTOUT(NTRMAX),
5742      &               CHI2OUT(NTRMAX),
5743      &               XMESOUT(NBCHAMBER,NTRMAX),YMESOUT(NBCHAMBER,NTRMAX)
5744      &              ,PXVOUT(NTRMAX),PYVOUT(NTRMAX),PZVOUT(NTRMAX)
5745
5746       DIMENSION ISEL(NTRMAX)
5747
5748       DO I = 1,NTREVT
5749          ISEL(I) = 1
5750       ENDDO
5751
5752       DO I = 1,NTREVT
5753
5754          ICH1 = 9
5755          JJ1 = JJOUT(ICH1,I)
5756          IF (JJ1.EQ.0) ICH1 = 10
5757          X1 = XMESOUT(ICH1,I)
5758          Y1 = YMESOUT(ICH1,I)
5759
5760          DO J = I+1,NTREVT
5761             ICH2 = 9
5762             JJ2 = JJOUT(ICH2,J)
5763             IF (JJ2.EQ.0) ICH2 = 10
5764             X2 = XMESOUT(ICH2,J)
5765             Y2 = YMESOUT(ICH2,J)
5766             DIST = SQRT(((X2-X1)/(10.*XPREC))**2
5767      &           +((Y2-Y1)/(10.*YPREC))**2)
5768             IF (DIST.LT.2.) THEN
5769                CHI21 =  CHI2OUT(I)
5770                CHI22 =  CHI2OUT(J)
5771                IF (CHI22.LT.CHI21) THEN
5772                   ISEL(I) = 0
5773                   IF (IDEBUG.EQ.2) THEN
5774                      PRINT *,' RECO_SELECT I,ISEL= ',I,ISEL(I)
5775                   ENDIF
5776                ELSE
5777                   ISEL(J) = 0
5778                   IF (IDEBUG.EQ.2) THEN
5779                      PRINT *,' RECO_SELECT J,ISEL= ',J,ISEL(J)
5780                   ENDIF
5781                ENDIF
5782             ENDIF
5783          ENDDO
5784
5785       ENDDO
5786
5787
5788       RETURN
5789       END
5790
5791 ***************************************************
5792       SUBROUTINE reconstmuon2(IFIT,IDEBUGC,NEV)
5793 ***************************************************
5794       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
5795
5796       PARAMETER(NPLANE=10,MAXIDG=28,NTRMAX=500)
5797
5798       REAL*4 PXR,PYR,PZR,ZVR,CHI2R,PXV,PYV,PZV
5799
5800       COMMON/TRACKFI/EFF,EFF1,EFF2,XPREC,YPREC,PHIPREC,ALAMPREC,
5801      &                 HCUT,LBKG,SIGCUT,ALPHATOP,HTOP
5802
5803       COMMON/PAWCR4/IEVR,NTRACKR,ISTATR(NTRMAX),ISIGNR(NTRMAX),
5804      &              PXR(NTRMAX),PYR(NTRMAX),PZR(NTRMAX),ZVR(NTRMAX),
5805      &              CHI2R(NTRMAX),PXV(NTRMAX),PYV(NTRMAX),PZV(NTRMAX)
5806
5807       COMMON/MEAS/LPLANE(NPLANE),XMP(NPLANE),YMP(NPLANE)
5808
5809       COMMON/FIT/NHITTOT1,izch(maxidg),xgeant(maxidg),
5810      &     ygeant(nplane)
5811
5812       COMMON/PRECCUT/PCUT,PTCUT,CHI2CUT
5813
5814       REAL*4 RN1,RN2
5815
5816 ** Read events
5817       CALL trackf_read_fit(IEVR,NEV,NHITTOT1,IZCH,XGEANT,YGEANT)
5818       print*,'nhittot1 ',nhittot1
5819
5820 *      do i=1,NHITTOT1
5821 *         print*,'x=',xgeant(i),' y=',ygeant(i),' ch=',izch(i)
5822 *      enddo
5823
5824       if (nhittot1.ne.20) goto 55
5825       nhit1=1
5826       nhit2=10
5827       do ntr=1,2                ! loop over tracks
5828          do nhit=nhit1,nhit2 ! loop over hits
5829             ich=izch(nhit)
5830             lplane(ich)=1
5831
5832             CALL RANNOR(RN1,RN2) ! CCC
5833 *            xmp(ich)=xgeant(nhit)
5834 *            ymp(ich)=ygeant(nhit)
5835             xmp(ich)=xgeant(nhit) + RN1 * XPREC
5836             ymp(ich)=ygeant(nhit) + RN2 * YPREC
5837          end do
5838          call fit_trace(ntr)
5839          nhit1=11
5840          nhit2=20
5841       end do
5842
5843       CALL CHFNT(IEVR,NTRACK,ISTATR,ISIGNR,
5844      &     PXR,PYR,PZR,ZVR,CHI2R,PXV,PYV,PZV)
5845
5846  55   continue
5847
5848       END
5849
5850 *********************************
5851       subroutine fit_trace(ntr)
5852 *********************************
5853 *
5854       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
5855
5856       PARAMETER(NPLANE=10,NTRACK=2,NTRMAX=500)
5857
5858       COMMON/FCNOUT/PXZEA,ALAMEA,PHIEA,XEA,YEA,NPLU,CHI2
5859
5860       REAL*4 PXR,PYR,PZR,ZVR,CHI2R,PXV,PYV,PZV
5861       COMMON/PAWCR4/IEVR,NTRACKR,ISTATR(NTRMAX),ISIGNR(NTRMAX),
5862      &              PXR(NTRMAX),PYR(NTRMAX),PZR(NTRMAX),ZVR(NTRMAX),
5863      &              CHI2R(NTRMAX),PXV(NTRMAX),PYV(NTRMAX),PZV(NTRMAX)
5864
5865       COMMON/MEAS/LPLANE(NPLANE),XMP(NPLANE),YMP(NPLANE)
5866
5867       COMMON/PARAM/ZPLANEP(NPLANE),THICK,XPREC,YPREC,B0,BL3,ZMAGS,
5868      &     ZMAGE,ZABS,XMAG,ZBP1,ZBP2,CONST
5869
5870       COMMON/PRECCUT/PCUT,PTCUT,CHI2CUT
5871
5872       dimension PXZOUT(NTRMAX),TPHIOUT(NTRMAX),TALAMOUT(NTRMAX),
5873      &     CHI2OUT(NTRMAX)
5874
5875       x1=xmp(1)
5876       y1=ymp(1)
5877       ipl1=1
5878       x2=xmp(3)
5879       y2=ymp(3)
5880       ipl2=3
5881       x3=xmp(7)
5882       ipl3=7
5883       x4=xmp(9)
5884       ipl4=9
5885
5886       PHIAV = DATAN2((X2-X1),(ZPLANEP(IPL2)-ZPLANEP(IPL1)))
5887       PHIAP = DATAN2((X4-X3),(ZPLANEP(IPL4)-ZPLANEP(IPL3)))
5888
5889       DPHI = (PHIAP-PHIAV)
5890       ASIGN = 1.
5891       IF (DPHI.LT.0.) ASIGN = -1. ! CCC
5892       PXZ = CONST/DABS(DPHI)
5893
5894 *     * Cuts PXZ
5895       IF (PXZ.LT.PCUT) GO TO 66
5896
5897       PXZINVI = ASIGN/PXZ       ! CCC
5898       PHII = PHIAV
5899       ALAMI = DATAN2((Y2-Y1),DSQRT((X2-X1)**2
5900      &     +(ZPLANEP(IPL2)-ZPLANEP(IPL1))**2))
5901       XVR = X1
5902       YVR = Y1
5903
5904 *         print *,' avant prec_fit pxzi phii alami x y',1./ PXZINVI,
5905 *     &         PHII, ALAMI ,XVR,YVR
5906 *         PRINT *,' X1 X2 X3 X4',X1,X2,X3,X4
5907 *         PRINT *,' Z1 Z2 Z3 Z4',ZPLANEP(IPL1),ZPLANEP(IPL2),
5908 *     &          ZPLANEP(IPL3),ZPLANEP(IPL4)
5909 *         PRINT *,' CONST= ',CONST
5910
5911 *     * Fit des traces apres l'absorbeur
5912       CALL PREC_FIT (PXZINVI,PHII,ALAMI,XVR,YVR,
5913      &     PXZINVF,PHIF,ALAMF,XVERTF,YVERTF,EPXZINV,EPHI,EALAM,
5914      &     EXVERT,EYVERT)
5915
5916 *     * Correction de Branson
5917       CALL BRANSON(PXZEA,PHIEA,ALAMEA,XEA,YEA)
5918
5919       PXZ1 = DABS(PXZEA)
5920       PX1 = PXZ1*DSIN(PHIEA)
5921       PY1 = PXZ1*DTAN(ALAMEA)
5922       PT1 = DSQRT(PX1**2+PY1**2)
5923
5924 *      print*,'pt1=',pt1
5925 *      print*,'ptcut=',ptcut
5926 *      print*,'chi2=',CHI2/FLOAT(2*NPLU-5)
5927 *      print*,'chi2cut=',CHI2CUT
5928
5929 *     * Cuts PT
5930       IF (PT1.LT.PTCUT) GO TO 66
5931 *     * Cuts CHI2
5932       IF ((CHI2/FLOAT(2*NPLU-5)).GT.CHI2CUT) GO TO 66
5933
5934       PXZOUT(NTR) = PXZEA
5935       TPHIOUT(NTR) = DTAN(PHIEA)
5936       TALAMOUT(NTR) = DTAN(ALAMEA)
5937       CHI2OUT(NTR) =  CHI2/FLOAT(2*NPLU-5)
5938
5939       ISIGNR(NTR) = 1
5940       IF (PXZOUT(NTR).LT.0.) ISIGNR(NTR) = -1
5941       PXZ = ABS(PXZOUT(NTR))
5942       PHI = ATAN(TPHIOUT(NTR))
5943       ALAM = ATAN(TALAMOUT(NTR))
5944       PYR(NTR) = PXZ*SIN(PHI)
5945       PXR(NTR) = PXZ*TAN(ALAM)
5946       PZR(NTR) = PXZ*COS(PHI)
5947
5948  66   CONTINUE
5949
5950       return
5951       end
5952
5953       SUBROUTINE SORTZV (A,INDEX,N1,MODE,NWAY,NSORT)
5954 C
5955 C CERN PROGLIB# M101    SORTZV          .VERSION KERNFOR  3.15  820113
5956 C ORIG. 02/10/75
5957 C
5958       DIMENSION A(N1),INDEX(N1)
5959 C
5960 C
5961       N = N1
5962       IF (N.LE.0)            RETURN
5963       IF (NSORT.NE.0) GO TO 2
5964       DO 1 I=1,N
5965     1 INDEX(I)=I
5966 C
5967     2 IF (N.EQ.1)            RETURN
5968       IF (MODE)    10,20,30
5969    10 CALL SORTTI (A,INDEX,N)
5970       GO TO 40
5971 C
5972    20 CALL SORTTC(A,INDEX,N)
5973       GO TO 40
5974 C
5975    30 CALL SORTTF (A,INDEX,N)
5976 C
5977    40 IF (NWAY.EQ.0) GO TO 50
5978       N2 = N/2
5979       DO 41 I=1,N2
5980       ISWAP = INDEX(I)
5981       K = N+1-I
5982       INDEX(I) = INDEX(K)
5983    41 INDEX(K) = ISWAP
5984    50 RETURN
5985       END
5986
5987       SUBROUTINE SORTTI (A,INDEX,N1)
5988 C
5989       INTEGER A,AI
5990       DIMENSION A(N1),INDEX(N1)
5991 C
5992       N = N1
5993       DO 3 I1=2,N
5994       I3 = I1
5995       I33 = INDEX(I3)
5996       AI = A(I33)
5997     1 I2 = I3/2
5998       IF (I2) 3,3,2
5999     2 I22 = INDEX(I2)
6000       IF (AI.LE.A (I22)) GO TO 3
6001       INDEX (I3) = I22
6002       I3 = I2
6003       GO TO 1
6004     3 INDEX (I3) = I33
6005     4 I3 = INDEX (N)
6006       INDEX (N) = INDEX (1)
6007       AI = A(I3)
6008       N = N-1
6009       IF (N-1) 12,12,5
6010     5 I1 = 1
6011     6 I2 = I1 + I1
6012       IF (I2.LE.N) I22= INDEX(I2)
6013       IF (I2-N) 7,9,11
6014     7 I222 = INDEX (I2+1)
6015       IF (A(I22)-A(I222)) 8,9,9
6016     8 I2 = I2+1
6017       I22 = I222
6018     9 IF (AI-A(I22)) 10,11,11
6019    10 INDEX(I1) = I22
6020       I1 = I2
6021       GO TO 6
6022    11 INDEX (I1) = I3
6023       GO TO 4
6024    12 INDEX (1) = I3
6025       RETURN
6026       END
6027
6028 *     ========================================
6029       SUBROUTINE SORTTC (A,INDEX,N1)
6030 C
6031       INTEGER A,AI
6032       DIMENSION A(N1),INDEX(N1)
6033 C
6034       N = N1
6035       DO 3 I1=2,N
6036       I3 = I1
6037       I33 = INDEX(I3)
6038       AI = A(I33)
6039     1 I2 = I3/2
6040       IF (I2) 3,3,2
6041     2 I22 = INDEX(I2)
6042       IF(ICMPCH(AI,A(I22)))3,3,21
6043    21 INDEX (I3) = I22
6044       I3 = I2
6045       GO TO 1
6046     3 INDEX (I3) = I33
6047     4 I3 = INDEX (N)
6048       INDEX (N) = INDEX (1)
6049       AI = A(I3)
6050       N = N-1
6051       IF (N-1) 12,12,5
6052     5 I1 = 1
6053     6 I2 = I1 + I1
6054       IF (I2.LE.N) I22= INDEX(I2)
6055       IF (I2-N) 7,9,11
6056     7 I222 = INDEX (I2+1)
6057       IF (ICMPCH(A(I22),A(I222))) 8,9,9
6058     8 I2 = I2+1
6059       I22 = I222
6060     9 IF (ICMPCH(AI,A(I22))) 10,11,11
6061    10 INDEX(I1) = I22
6062       I1 = I2
6063       GO TO 6
6064    11 INDEX (I1) = I3
6065       GO TO 4
6066    12 INDEX (1) = I3
6067       RETURN
6068       END
6069 *     ========================================
6070       FUNCTION ICMPCH(IC1,IC2)
6071 C     FUNCTION TO COMPARE TWO 4 CHARACTER EBCDIC STRINGS - IC1,IC2
6072 C     ICMPCH=-1 IF HEX VALUE OF IC1 IS LESS THAN IC2
6073 C     ICMPCH=0  IF HEX VALUES OF IC1 AND IC2 ARE THE SAME
6074 C     ICMPCH=+1 IF HEX VALUES OF IC1 IS GREATER THAN IC2
6075       I1=IC1
6076       I2=IC2
6077       IF(I1.GE.0.AND.I2.GE.0)GOTO 40
6078       IF(I1.GE.0)GOTO 60
6079       IF(I2.GE.0)GOTO 80
6080       I1=-I1
6081       I2=-I2
6082       IF(I1-I2)80,70,60
6083  40   IF(I1-I2)60,70,80
6084  60   ICMPCH=-1
6085       RETURN
6086  70   ICMPCH=0
6087       RETURN
6088  80   ICMPCH=1
6089       RETURN
6090       END
6091
6092       SUBROUTINE SORTTF (A,INDEX,N1)
6093 C
6094       DIMENSION A(N1),INDEX(N1)
6095 C
6096       N = N1
6097       DO 3 I1=2,N
6098       I3 = I1
6099       I33 = INDEX(I3)
6100       AI = A(I33)
6101     1 I2 = I3/2
6102       IF (I2) 3,3,2
6103     2 I22 = INDEX(I2)
6104       IF (AI.LE.A (I22)) GO TO 3
6105       INDEX (I3) = I22
6106       I3 = I2
6107       GO TO 1
6108     3 INDEX (I3) = I33
6109     4 I3 = INDEX (N)
6110       INDEX (N) = INDEX (1)
6111       AI = A(I3)
6112       N = N-1
6113       IF (N-1) 12,12,5
6114     5 I1 = 1
6115     6 I2 = I1 + I1
6116       IF (I2.LE.N) I22= INDEX(I2)
6117       IF (I2-N) 7,9,11
6118     7 I222 = INDEX (I2+1)
6119       IF (A(I22)-A(I222)) 8,9,9
6120     8 I2 = I2+1
6121       I22 = I222
6122     9 IF (AI-A(I22)) 10,11,11
6123    10 INDEX(I1) = I22
6124       I1 = I2
6125       GO TO 6
6126    11 INDEX (I1) = I3
6127       GO TO 4
6128    12 INDEX (1) = I3
6129       RETURN
6130       END