TEvtGen/PHOTOS/phcork.F

   1
   2
   3
   4       SUBROUTINE PHCORK(MODCOR)
   5       implicit none
   6 C.----------------------------------------------------------------------
   7 C.
   8 C.    PHCORK: corrects kinmatics of subbranch needed if host program
   9 C.            produces events with the shaky momentum conservation
  10 C
  11 C.    Input Parameters:   Common /PHOEVT/, MODCOR
  12 C.                        MODCOR >0 type of action
  13 C.                               =1 no action
  14 C.                               =2 corrects energy from mass
  15 C.                               =3 corrects mass from energy
  16 C.                               =4 corrects energy from mass for
  17 C.                                  particles up to .4 GeV mass,
  18 C.                                  for heavier ones corrects mass,
  19 C.                               =0 execution mode
  20 C.
  21 C.    Output Parameters:  corrected /PHOEVT/
  22 C.
  23 C.    Author(s):  P.Golonka, Z. Was               Created at:  01/02/99
  24 C.                                                Modified  :  08/02/99
  25 C.----------------------------------------------------------------------
  26       INTEGER NMXPHO
  27       PARAMETER (NMXPHO=10000)
  28
  29       REAL*8 M,P2,PX,PY,PZ,E,EN,MCUT
  30       INTEGER MODCOR,MODOP,I,IEV,IPRINT
  31       INTEGER IDPHO,ISTPHO,JDAPHO,JMOPHO,NEVPHO,NPHO
  32       REAL*8 PPHO,VPHO
  33       COMMON/PHOEVT/NEVPHO,NPHO,ISTPHO(NMXPHO),IDPHO(NMXPHO),
  34      &JMOPHO(2,NMXPHO),JDAPHO(2,NMXPHO),PPHO(5,NMXPHO),VPHO(4,NMXPHO)
  35
  36       INTEGER PHLUN
  37       COMMON/PHOLUN/PHLUN
  38
  39       COMMON /PHNUM/ IEV
  40       SAVE MODOP
  41       DATA MODOP  /0/
  42       SAVE IPRINT
  43       DATA IPRINT /0/
  44       SAVE MCUT
  45       IF (MODCOR.NE.0) THEN
  46 C       INITIALIZATION
  47         MODOP=MODCOR
  48
  49         WRITE(PHLUN,*) 'Message from PHCORK(MODCOR):: initialization'
  50         IF     (MODOP.EQ.1) THEN
  51           WRITE(PHLUN,*) 'MODOP=1 -- no corrections on event: DEFAULT'
  52         ELSEIF (MODOP.EQ.2) THEN
  53           WRITE(PHLUN,*) 'MODOP=2 -- corrects Energy from mass'
  54         ELSEIF (MODOP.EQ.3) THEN
  55           WRITE(PHLUN,*) 'MODOP=3 -- corrects mass from Energy'
  56         ELSEIF (MODOP.EQ.4) THEN
  57           WRITE(PHLUN,*) 'MODOP=4 -- corrects Energy from mass to Mcut'
  58           WRITE(PHLUN,*) '           and mass from  energy above  Mcut '
  59           MCUT=0.4
  60           WRITE(PHLUN,*) 'Mcut=',MCUT,'GeV'
  61         ELSE
  62           WRITE(PHLUN,*) 'PHCORK wrong MODCOR=',MODCOR
  63           STOP
  64         ENDIF
  65         RETURN
  66       ENDIF
  67
  68       IF (MODOP.EQ.0.AND.MODCOR.EQ.0) THEN
  69         WRITE(PHLUN,*) 'PHCORK lack of initialization'
  70         STOP
  71       ENDIF
  72
  73 C execution mode
  74 C ==============
  75 C ==============
  76
  77
  78         PX=0
  79         PY=0
  80         PZ=0
  81         E =0
  82
  83       IF    (MODOP.EQ.1) THEN
  84 C     -----------------------
  85 C       In this case we do nothing
  86         RETURN
  87       ELSEIF(MODOP.EQ.2) THEN
  88 C     -----------------------
  89 CC      lets loop thru all daughters and correct their energies
  90 CC      according to E^2=p^2+m^2
  91
  92        DO I=3,NPHO
  93
  94          PX=PX+PPHO(1,I)
  95          PY=PY+PPHO(2,I)
  96          PZ=PZ+PPHO(3,I)
  97
  98          P2=PPHO(1,I)**2+PPHO(2,I)**2+PPHO(3,I)**2
  99
 100          EN=SQRT( PPHO(5,I)**2 + P2)
 101
 102          IF (IPRINT.EQ.1)
 103      &   WRITE(PHLUN,*) 'CORRECTING ENERGY OF ',I,':',
 104      &        PPHO(4,I),'=>',EN
 105
 106          PPHO(4,I)=EN
 107          E = E+PPHO(4,I)
 108
 109        ENDDO
 110
 111       ELSEIF(MODOP.EQ.3) THEN
 112 C     -----------------------
 113
 114 CC      lets loop thru all daughters and correct their masses
 115 CC      according to E^2=p^2+m^2
 116
 117        DO I=3,NPHO
 118
 119          PX=PX+PPHO(1,I)
 120          PY=PY+PPHO(2,I)
 121          PZ=PZ+PPHO(3,I)
 122          E = E+PPHO(4,I)
 123
 124          P2=PPHO(1,I)**2+PPHO(2,I)**2+PPHO(3,I)**2
 125
 126          M=SQRT(ABS( PPHO(4,I)**2 - P2))
 127
 128          IF (IPRINT.EQ.1)
 129      &   WRITE(PHLUN,*) 'CORRECTING MASS OF ',I,':',
 130      &        PPHO(5,I),'=>',M
 131
 132          PPHO(5,I)=M
 133
 134        ENDDO
 135
 136
 137       ELSEIF(MODOP.EQ.4) THEN
 138 C     -----------------------
 139
 140 CC      lets loop thru all daughters and correct their masses
 141 CC      or energies according to E^2=p^2+m^2
 142
 143        DO I=3,NPHO
 144
 145          PX=PX+PPHO(1,I)
 146          PY=PY+PPHO(2,I)
 147          PZ=PZ+PPHO(3,I)
 148
 149          P2=PPHO(1,I)**2+PPHO(2,I)**2+PPHO(3,I)**2
 150
 151          M=SQRT(ABS( PPHO(4,I)**2 - P2))
 152
 153          IF (M.GT.MCUT) THEN
 154           IF (IPRINT.EQ.1)
 155      &    WRITE(PHLUN,*) 'CORRECTING MASS OF ',I,':',
 156      &         PPHO(5,I),'=>',M
 157           PPHO(5,I)=M
 158           E = E+PPHO(4,I)
 159          ELSE
 160
 161           EN=SQRT( PPHO(5,I)**2 + P2)
 162
 163          IF (IPRINT.EQ.1)
 164      &    WRITE(PHLUN,*) 'CORRECTING ENERGY OF ',I,':',
 165      &        PPHO(4,I),'=>',EN
 166
 167           PPHO(4,I)=EN
 168           E = E+PPHO(4,I)
 169          ENDIF
 170
 171        ENDDO
 172       ENDIF
 173 C     -----
 174
 175        IF (IPRINT.EQ.1) THEN
 176         WRITE(PHLUN,*) 'CORRECTING MOTHER'
 177         WRITE(PHLUN,*) 'PX:',PPHO(1,1),'=>',PX-PPHO(1,2)
 178         WRITE(PHLUN,*) 'PY:',PPHO(2,1),'=>',PY-PPHO(2,2)
 179         WRITE(PHLUN,*) 'PZ:',PPHO(3,1),'=>',PZ-PPHO(3,2)
 180         WRITE(PHLUN,*) ' E:',PPHO(4,1),'=>',E-PPHO(4,2)
 181        ENDIF
 182
 183        PPHO(1,1)=PX-PPHO(1,2)
 184        PPHO(2,1)=PY-PPHO(2,2)
 185        PPHO(3,1)=PZ-PPHO(3,2)
 186        PPHO(4,1)=E -PPHO(4,2)
 187
 188        P2=PPHO(1,1)**2+PPHO(2,1)**2+PPHO(3,1)**2
 189
 190        IF (PPHO(4,1)**2.GT.P2) THEN
 191           M=SQRT( PPHO(4,1)**2 - P2 )
 192           IF (IPRINT.EQ.1)
 193      &    WRITE(PHLUN,*) ' M:',PPHO(5,1),'=>',M
 194           PPHO(5,1)=M
 195        ENDIF
 196
 197       CALL PHLUPA(25)
 198
 199       END