00001 SUBROUTINE TAUOLA(MODE,KEYPOL)
00002
00003
00004
00005
00006
00007
00008
00009 #include "../../include/HEPEVT.h"
00010 COMMON /TAUPOS/ NP1, NP2
00011 REAL*4 PHOI(4),PHOF(4)
00012 double precision Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4)
00013 COMMON / MOMDEC / Q1,Q2,P1,P2,P3,P4
00014
00015 COMMON /LIBRA/ JAK1,JAK2,ITDKRC,IFPHOT,IFHADM,IFHADP
00016 REAL*4 RRR(1)
00017 LOGICAL IFPSEUDO
00018 common /pseudocoup/ csc,ssc
00019 REAL*4 csc,ssc
00020 save pseudocoup
00021 COMMON / INOUT / INUT,IOUT
00022
00023
00024 DIMENSION POL1(4), POL2(4)
00025 double precision POL1x(4), POL2x(4)
00026 INTEGER ION(3)
00027 DATA POL1 /0.0,0.0,0.0,0.0/
00028 DATA POL2 /0.0,0.0,0.0,0.0/
00029 DATA PI /3.141592653589793238462643D0/
00030
00031
00032 DIMENSION IMOTHER (20)
00033 INTEGER KFHIGGS(3)
00034
00035
00036 INTEGER ISON
00037 COMMON /ISONS_TAU/ISON(2)
00038 SAVE /ISONS_TAU/
00039
00040 IF(MODE.EQ.-1) THEN
00041
00042
00043 JAK1 = 0
00044 JAK2 = 0
00045 ITDKRC=1.0
00046 IFPHOT=1.0
00047 IFHADM=1.0
00048 IFHADP=1.0
00049 POL=1.0
00050
00051 KFHIGGS(1) = 25
00052 KFHIGGS(2) = 35
00053 KFHIGGS(3) = 36
00054 KFHIGCH = 37
00055 KFZ0 = 23
00056 KFGAM = 22
00057 KFTAU = 15
00058 KFNUE = 16
00059
00060 psi=0.5*PI
00061 xmtau=1.777
00062 xmh=120
00063 betah=sqrt(1d0-4*xmtau**2/xmh**2)
00064 csc=cos(psi)*betah
00065 ssc=sin(psi)
00066
00067 IF (IFPHOT.EQ.1) CALL PHOINI
00068 CALL INIETC(JAK1,JAK2,ITDKRC,IFPHOT)
00069 CALL INIMAS
00070 CALL INIPHX(0.01d0)
00071 CALL INITDK
00072
00073 ION(1)=1
00074 ION(2)=1
00075 ION(3)=1
00076 CALL TAUPI0(-1,1,ION)
00077 CALL DEKAY(-1,POL1x)
00078 WRITE(IOUT,7001) pol,psi,ION(1),ION(2),ION(3)
00079 ELSEIF(MODE.EQ.0) THEN
00080
00081
00082
00083
00084 CALL PHYFIX(NSTOP,NSTART)
00085
00086 DO II=1,20
00087 IMOTHER(II)=0
00088 ENDDO
00089
00090 DO II=1,2
00091 ISON(II)=0
00092 ENDDO
00093
00094 NDEC = 0
00095
00096 DO I=NSTART,NHEP
00097 IF(ABS(IDHEP(I)).EQ.KFTAU.AND.ISTHEP(I).EQ.1.AND.
00098 $ (ISTHEP(I).GE.125.OR.ISTHEP(I).LT.120)) THEN
00099 IMOTH=JMOHEP(1,I)
00100 DO WHILE (ABS(IDHEP(IMOTH)).EQ.KFTAU)
00101 IMOTH=JMOHEP(1,IMOTH)
00102 ENDDO
00103 IF (ISTHEP(IMOTH).EQ.3.OR.
00104 $ (ISTHEP(IMOTH).GE.120.AND.ISTHEP(IMOTH).LE.125)) THEN
00105 DO J=NSTART,NHEP
00106 IF (IDHEP(J).EQ.IDHEP(IMOTH).AND.
00107 $ JMOHEP(1,J).EQ.IMOTH.AND.
00108 $ ISTHEP(J).EQ.2) THEN
00109 JMOTH=J
00110 GOTO 66
00111 ENDIF
00112 ENDDO
00113 ELSE
00114 JMOTH=IMOTH
00115 ENDIF
00116 66 CONTINUE
00117 DO II=1,NDEC
00118 IF(JMOTH.EQ.IMOTHER(II)) GOTO 9999
00119 ENDDO
00120
00121 NDEC=NDEC+1
00122 IMOTHER(NDEC)= JMOTH
00123 ENDIF
00124 9999 CONTINUE
00125 ENDDO
00126
00127
00128 DO II=1,NDEC
00129 IM=IMOTHER(II)
00130 NCOUNT=0
00131 NP1=0
00132 NP2=0
00133
00134
00135
00136
00137 IM0=IM
00138 IF (IDHEP(JMOHEP(1,IM0)).EQ.IDHEP(IM0)) IM0=JMOHEP(1,IM0)
00139 ISEL=-1
00140 DO I=NSTART,NHEP
00141 IF (ISTHEP(I).EQ.3.OR.
00142 $ (ISTHEP(I).GE.120.AND.ISTHEP(I).LE.125)) THEN
00143 GOTO 76
00144 ENDIF
00145 IMOTH=JMOHEP(1,I)
00146 DO WHILE (IDHEP(IMOTH).EQ.IDHEP(I).OR.ABS(IDHEP(IMOTH)).EQ.KFTAU)
00147 IMOTH=JMOHEP(1,IMOTH)
00148 ENDDO
00149 IF ((IMOTH.EQ.IM0.OR.IMOTH.EQ.IM).AND.ISEL.EQ.-1) THEN
00150 ISON(1)=I
00151 ISEL=0
00152 ELSEIF ((IMOTH.EQ.IM0.OR.IMOTH.EQ.IM).AND.ISEL.EQ.0) THEN
00153 ISON(2)=I
00154 ELSEIF ((IMOTH.NE.IM0.AND.IMOTH.NE.IM).AND.ISEL.EQ.0) THEN
00155 ISEL=1
00156 GOTO 77
00157 ENDIF
00158 76 CONTINUE
00159 ENDDO
00160 77 CONTINUE
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178 DO I=ISON(1),ISON(2)
00179 IF(IDHEP(I).EQ.-KFTAU.OR.IDHEP(I).EQ.-KFNUE) NCOUNT=NCOUNT+1
00180 IF(IDHEP(I).EQ. KFTAU.OR.IDHEP(I).EQ. KFNUE) NCOUNT=NCOUNT+1
00181 ENDDO
00182
00183
00184 666 CONTINUE
00185
00186
00187 DO I=MAX(NP1+1,ISON(1)),ISON(2)
00188
00189 IF(IDHEP(I).EQ.-KFTAU.OR.IDHEP(I).EQ.-KFNUE) NP1=I
00190 ENDDO
00191
00192 DO I=MAX(NP2+1,ISON(1)),ISON(2)
00193
00194 IF(IDHEP(I).EQ. KFTAU.OR.IDHEP(I).EQ. KFNUE) NP2=I
00195 ENDDO
00196 DO I=1,4
00197 P1(I)= PHEP(I,NP1)
00198 P2(I)= PHEP(I,NP2)
00199 Q1(I)= P1(I)+P2(I)
00200 ENDDO
00201
00202 POL1(3)= 0D0
00203 POL2(3)= 0D0
00204
00205 IF(KEYPOL.EQ.1) THEN
00206
00207 CALL RANMAR(RRR,1)
00208
00209 IF(IDHEP(IM).EQ.KFHIGGS(1).OR.IDHEP(IM).EQ.KFHIGGS(2).OR.
00210 $ IDHEP(IM).EQ.KFHIGGS(3)) THEN
00211 IF(RRR(1).LT.0.5) THEN
00212 POL1(3)= POL
00213 POL2(3)=-POL
00214 ELSE
00215 POL1(3)=-POL
00216 POL2(3)= POL
00217 ENDIF
00218 ELSEIF((IDHEP(IM).EQ.KFZ0).OR.(IDHEP(IM).EQ.KFGAM)) THEN
00219
00220
00221
00222
00223
00224
00225
00226 POLZ0=PLZAPX(.true.,IM,NP1,NP2)
00227 IF(RRR(1).LT.POLZ0) THEN
00228 POL1(3)= POL
00229 POL2(3)= POL
00230 ELSE
00231 POL1(3)=-POL
00232 POL2(3)=-POL
00233 ENDIF
00234 ELSEIF(IDHEP(NP1).EQ.-IDHEP(NP2))THEN
00235 POLZ0=PLZAPX(.true.,IM,NP1,NP2)
00236 IF(RRR(1).LT.POLZ0) THEN
00237 POL1(3)= POL
00238 POL2(3)= POL
00239 ELSE
00240 POL1(3)=-POL
00241 POL2(3)=-POL
00242 ENDIF
00243 ELSEIF(ABS(IDHEP(IM)).EQ.KFHIGCH) THEN
00244 POL1(3)= POL
00245 POL2(3)= POL
00246 ELSE
00247 POL1(3)= -POL
00248 POL2(3)= -POL
00249 ENDIF
00250
00251 ENDIF
00252
00253 IF(IDHEP(IM).EQ.KFHIGGS(1).OR.IDHEP(IM).EQ.KFHIGGS(2).OR.
00254 $ IDHEP(IM).EQ.KFHIGGS(3)) THEN
00255 IF(IDHEP(NP1).EQ.-KFTAU .AND.
00256 $ (JDAHEP(1,NP1).LE.NP1.OR.JDAHEP(1,NP1).GT.NHEP) .AND.
00257 $ IDHEP(NP2).EQ. KFTAU .AND.
00258 $ (JDAHEP(1,NP2).LE.NP2.OR.JDAHEP(1,NP2).GT.NHEP)
00259 $ ) THEN
00260 IF (IDHEP(IM).EQ.KFHIGGS(1)) THEN
00261 IFPSEUDO= .FALSE.
00262 ELSEIF (IDHEP(IM).EQ.KFHIGGS(2)) THEN
00263 IFPSEUDO= .FALSE.
00264 ELSEIF (IDHEP(IM).EQ.KFHIGGS(3)) THEN
00265 IFPSEUDO= .TRUE.
00266 ELSE
00267 WRITE(*,*) 'Warning from TAUOLA:'
00268 WRITE(*,*) 'I stop this run, wrong IDHEP(IM)=',IDHEP(IM)
00269 STOP
00270 ENDIF
00271 CALL SPINHIGGS(IM,NP1,NP2,IFPSEUDO,Pol1,Pol2)
00272 IF (IFPHOT.EQ.1) CALL PHOTOS(IM)
00273
00274
00275
00276 ENDIF
00277 ELSE
00278 IF(IDHEP(NP1).EQ.-KFTAU.AND.
00279 $ (JDAHEP(1,NP1).LE.NP1.OR.JDAHEP(1,NP1).GT.NHEP)) THEN
00280
00281 CALL DEXAY(1,POL1)
00282 IF (IFPHOT.EQ.1) CALL PHOTOS(NP1)
00283 CALL TAUPI0(0,1,ION)
00284 ENDIF
00285
00286 IF(IDHEP(NP2).EQ. KFTAU.AND.
00287 $ (JDAHEP(1,NP2).LE.NP2.OR.JDAHEP(1,NP2).GT.NHEP)) THEN
00288
00289 CALL DEXAY(2,POL2)
00290 IF (IFPHOT.EQ.1) CALL PHOTOS(NP2)
00291 CALL TAUPI0(0,2,ION)
00292 ENDIF
00293 ENDIF
00294 NCOUNT=NCOUNT-2
00295 IF (NCOUNT.GT.0) GOTO 666
00296 ENDDO
00297
00298 ELSEIF(MODE.EQ.1) THEN
00299
00300
00301 CALL DEXAY(100,POL1)
00302 CALL DEKAY(100,POL1x)
00303 WRITE(IOUT,7002)
00304 ENDIF
00305
00306 7001 FORMAT(///1X,15(5H*****)
00307 $ /,' *', 25X,'*****TAUOLA UNIVERSAL INTERFACE: ******',9X,1H*,
00308 $ /,' *', 25X,'*****VERSION 1.22, April 2009 (gfort)**',9X,1H*,
00309 $ /,' *', 25X,'**AUTHORS: P. Golonka, B. Kersevan, ***',9X,1H*,
00310 $ /,' *', 25X,'**T. Pierzchala, E. Richter-Was, ******',9X,1H*,
00311 $ /,' *', 25X,'****** Z. Was, M. Worek ***************',9X,1H*,
00312 $ /,' *', 25X,'**USEFUL DISCUSSIONS, IN PARTICULAR ***',9X,1H*,
00313 $ /,' *', 25X,'*WITH C. Biscarat and S. Slabospitzky**',9X,1H*,
00314 $ /,' *', 25X,'****** are warmly acknowledged ********',9X,1H*,
00315 $ /,' *', 25X,' ',9X,1H*,
00316 $ /,' *', 25X,'********** INITIALIZATION ************',9X,1H*,
00317 $ /,' *',F20.5,5X,'tau polarization switch must be 1 or 0 ',9X,1H*,
00318 $ /,' *',F20.5,5X,'Higs scalar/pseudo mix CERN-TH/2003-166',9X,1H*,
00319 $ /,' *',I10, 15X,'PI0 decay switch must be 1 or 0 ',9X,1H*,
00320 $ /,' *',I10, 15X,'ETA decay switch must be 1 or 0 ',9X,1H*,
00321 $ /,' *',I10, 15X,'K0S decay switch must be 1 or 0 ',9X,1H*,
00322 $ /,1X,15(5H*****)/)
00323
00324 7002 FORMAT(///1X,15(5H*****)
00325 $ /,' *', 25X,'*****TAUOLA UNIVERSAL INTERFACE: ******',9X,1H*,
00326 $ /,' *', 25X,'*****VERSION 1.22, April 2009 (gfort)**',9X,1H*,
00327 $ /,' *', 25X,'**AUTHORS: P. Golonka, B. Kersevan, ***',9X,1H*,
00328 $ /,' *', 25X,'**T. Pierzchala, E. Richter-Was, ******',9X,1H*,
00329 $ /,' *', 25X,'****** Z. Was, M. Worek ***************',9X,1H*,
00330 $ /,' *', 25X,'**USEFUL DISCUSSIONS, IN PARTICULAR ***',9X,1H*,
00331 $ /,' *', 25X,'*WITH C. Biscarat and S. Slabospitzky**',9X,1H*,
00332 $ /,' *', 25X,'****** are warmly acknowledged ********',9X,1H*,
00333 $ /,' *', 25X,'****** END OF MODULE OPERATION ********',9X,1H*,
00334 $ /,1X,15(5H*****)/)
00335
00336 END
00337
00338 SUBROUTINE SPINHIGGS(IM,NP1,NP2,IFPSEUDO,Pol1,Pol2)
00339 LOGICAL IFPSEUDO
00340 REAL*8 HH1,HH2,wthiggs
00341 DIMENSION POL1(4), POL2(4),HH1(4),HH2(4), RRR(1)
00342
00343
00344 INTEGER ION(3)
00345 10 CONTINUE
00346 CALL RANMAR(RRR,1)
00347 CALL DEKAY(1,HH1)
00348 CALL DEKAY(2,HH2)
00349 wt=wthiggs(IFPSEUDO,HH1,HH2)
00350 IF (RRR(1).GT.WT) GOTO 10
00351 CALL DEKAY(1+10,HH1)
00352 CALL TAUPI0(0,1,ION)
00353 CALL DEKAY(2+10,HH2)
00354 CALL TAUPI0(0,2,ION)
00355 END
00356 FUNCTION wthiggs(IFPSEUDO,HH1,HH2)
00357 LOGICAL IFPSEUDO
00358 common /pseudocoup/ csc,ssc
00359 REAL*4 csc,ssc
00360 save pseudocoup
00361 REAL*8 HH1(4),HH2(4),R(4,4),wthiggs
00362 DO K=1,4
00363 DO L=1,4
00364 R(K,L)=0
00365 ENDDO
00366 ENDDO
00367 WTHIGGS=0D0
00368
00369 R(4,4)= 1D0
00370 R(3,3)=-1D0
00371
00372 IF (IFPSEUDO) THEN
00373 R(1,1)=-1
00374 R(2,2)= -1
00375 R(1,1)=(csc**2-ssc**2)/(csc**2+ssc**2)
00376 R(2,2)=(csc**2-ssc**2)/(csc**2+ssc**2)
00377 R(1,2)=2*csc*ssc/(csc**2+ssc**2)
00378 R(2,1)=-2*csc*ssc/(csc**2+ssc**2)
00379 ELSE
00380 R(1,1)=1
00381 R(2,2)=1
00382 ENDIF
00383
00384
00385
00386 DO K=1,4
00387 DO L=1,4
00388 WTHIGGS=WTHIGGS+R(K,L)*HH1(K)*HH2(L)
00389 ENDDO
00390 ENDDO
00391 WTHIGGS=WTHIGGS/4D0
00392 END
00393
00394 FUNCTION PLZAPX(HOPEin,IM0,NP1,NP2)
00395
00396
00397
00398
00399 REAL*8 PLZAP0,SVAR,COSTHE,sini,sfin,ZPROP2,
00400 $ P1(4),P2(4),Q1(4),Q2(4),QQ(4),PH(4),PD1(4),PD2(4),
00401 $ PQ1(4),PQ2(4),PB(4),PA(4)
00402 REAL*4 PLZAPX
00403 INTEGER IM
00404 LOGICAL HOPE,HOPEin
00405 #include "../../include/HEPEVT.h"
00406
00407
00408 INTEGER ISON
00409 COMMON /ISONS_TAU/ISON(2)
00410
00411
00412
00413
00414 HOPE=HOPEin
00415
00416 IM=IM0
00417 IM00=JMOHEP(1,IM0)
00418
00419 IF (IM00.GT.0) THEN
00420 IF (IDHEP(IM0).EQ.IDHEP(IM00)) IM=JMOHEP(1,IM0)
00421 ENDIF
00422
00423
00424 IMO1=JMOHEP(1,IM)
00425 IMO2=JMOHEP(2,IM)
00426
00427
00428 IM00=IMO1
00429 IF (ISTHEP(IM00).EQ.120) THEN
00430 IMO1=JMOHEP(1,IM00)
00431 IMO2=JMOHEP(2,IM00)
00432 ENDIF
00433
00434
00435 IFFULL=0
00436
00437 IF (IMO1.EQ.0.AND.IMO2.EQ.0) THEN
00438 IMO1=JMOHEP(1,NP1)
00439
00440 IF (IDHEP(IMO1).EQ.IDHEP(NP1)) IMO1=JMOHEP(1,IMO1)
00441
00442 IMO2=JMOHEP(2,NP1)
00443
00444 IF (IDHEP(IMO2).EQ.IDHEP(NP2)) IMO2=JMOHEP(1,IMO2)
00445
00446 IFFULL=1
00447
00448
00449 ELSEIF (IDHEP(IM).NE.22.AND.IDHEP(IM).NE.23) THEN
00450 IMO1=JMOHEP(1,NP1)
00451
00452 IF (IDHEP(IMO1).EQ.IDHEP(NP1)) IMO1=JMOHEP(1,IMO1)
00453
00454 IMO2=JMOHEP(2,NP1)
00455
00456 IF (IDHEP(IMO2).EQ.IDHEP(NP2)) IMO2=JMOHEP(1,IMO2)
00457
00458 IFFULL=1
00459 ENDIF
00460
00461
00462
00463 IF (IMO1.EQ.0) HOPE=.FALSE.
00464 IF (IMO2.EQ.0) HOPE=.FALSE.
00465 IF (IMO1.EQ.IMO2) HOPE=.FALSE.
00466
00467
00468 DO I=1,4
00469 Q1(I)= PHEP(I,NP1)
00470 Q2(I)= PHEP(I,NP2)
00471 ENDDO
00472
00473
00474
00475 IF (IM.EQ.JMOHEP(1,IM0).AND.
00476 $ (IDHEP(IM).EQ.22.OR.IDHEP(IM).EQ.23)) THEN
00477 DO K=1,4
00478 PB(K)=PHEP(K,IM)
00479 PA(K)=PHEP(K,IM0)
00480 ENDDO
00481
00482
00483 CALL BOSTDQ( 1,PA, Q1, Q1)
00484 CALL BOSTDQ( 1,PA, Q2, Q2)
00485 CALL BOSTDQ(-1,PB, Q1, Q1)
00486 CALL BOSTDQ(-1,PB, Q2, Q2)
00487
00488 ENDIF
00489
00490 DO I=1,4
00491 QQ(I)= Q1(I)+Q2(I)
00492 IF (HOPE) P1(I)=PHEP(I,IMO1)
00493 IF (HOPE) P2(I)=PHEP(I,IMO2)
00494 PH(I)=0D0
00495 PD1(I)=0D0
00496 PD2(I)=0D0
00497 ENDDO
00498
00499 IDFQ1=IDHEP(NP1)
00500 IDFQ2=IDHEP(NP2)
00501 IF (HOPE) IDFP1=IDHEP(IMO1)
00502 IF (HOPE) IDFP2=IDHEP(IMO2)
00503
00504 SVAR=QQ(4)**2-QQ(3)**2-QQ(2)**2-QQ(1)**2
00505 IF (.NOT.HOPE) THEN
00506
00507
00508
00509
00510 PLZAPX=0.5
00511 RETURN
00512 ENDIF
00513
00514
00515
00516
00517
00518
00519
00520 NX1=JDAHEP(1,IM00)
00521 NX2=JDAHEP(2,IM00)
00522
00523 INBR=IM
00524 IF (IFFULL.EQ.1) INBR=NP1
00525 IF (IDHEP(JMOHEP(1,INBR)).EQ.IDHEP(INBR)) INBR=JMOHEP(1,INBR)
00526
00527 IF(NX1.EQ.0.OR.NX2.EQ.0) THEN
00528 NX1=INBR
00529 NX2=INBR
00530 DO K=1,INBR-1
00531 IF(JMOHEP(1,INBR-K).EQ.JMOHEP(1,INBR)) THEN
00532 NX1=INBR-K
00533 ELSE
00534 GOTO 7
00535 ENDIF
00536 ENDDO
00537 7 CONTINUE
00538
00539 DO K=INBR+1,NHEP
00540 IF(JMOHEP(1,K).EQ.JMOHEP(1,INBR)) THEN
00541 NX2=K
00542 ELSE
00543 GOTO 8
00544 ENDIF
00545 ENDDO
00546 8 CONTINUE
00547 ENDIF
00548
00549
00550 IF (ABS(IDFP1).GE.20.AND.ABS(IDFP2).GE.20) HOPE=.FALSE.
00551
00552 IF (ABS(IDFP1).LE.20.AND.ABS(IDFP2).LE.20.AND.IDFP1+IDFP2.NE.0)
00553 $ HOPE=.FALSE.
00554 IF (.NOT.HOPE) THEN
00555
00556
00557
00558
00559 PLZAPX=0.5
00560 RETURN
00561 ENDIF
00562 IF (ABS(IDFP1).LT.20) IDE= IDFP1
00563 IF (ABS(IDFP2).LT.20) IDE=-IDFP2
00564
00565
00566
00567
00568
00569
00570
00571
00572
00573 DO L=1,4
00574 PD1(L)=P1(L)
00575 PD2(L)=P2(L)
00576 ENDDO
00577
00578 DO L=1,4
00579 PQ1(L)=Q1(L)
00580 PQ2(L)=Q2(L)
00581 ENDDO
00582
00583 IFLAV=min(ABS(IDFP1),ABS(IDFP2))
00584
00585
00586
00587
00588
00589
00590
00591
00592
00593 IF (ABS(IDFP1).GE.20) THEN
00594 DO k=NX1,NX2
00595 IDP=IDHEP(k)
00596 IF (ABS(IDP).EQ.IFLAV) THEN
00597 DO L=1,4
00598 PD1(L)=-PHEP(L,K)
00599 ENDDO
00600 ENDIF
00601 ENDDO
00602 ENDIF
00603
00604 IF (ABS(IDFP2).GE.20) THEN
00605 DO k=NX1,NX2
00606 IDP=IDHEP(k)
00607 IF (ABS(IDP).EQ.IFLAV) THEN
00608 DO L=1,4
00609 PD2(L)=-PHEP(L,K)
00610 ENDDO
00611 ENDIF
00612 ENDDO
00613 ENDIF
00614
00615
00616
00617 IF (ABS(IDFP1).GE.20) THEN
00618 DO L=1,4
00619 PH(L)=P1(L)
00620 ENDDO
00621 xm1=abs((PD1(4)+PH(4))**2-(PD1(3)+PH(3))**2
00622 $ -(PD1(2)+PH(2))**2-(PD1(1)+PH(1))**2)
00623 xm2=abs((PD2(4)+PH(4))**2-(PD2(3)+PH(3))**2
00624 $ -(PD2(2)+PH(2))**2-(PD2(1)+PH(1))**2)
00625 IF (XM1.LT.XM2) THEN
00626 DO L=1,4
00627 PD1(L)=PD1(L)+P1(L)
00628 ENDDO
00629 ELSE
00630 DO L=1,4
00631 PD2(L)=PD2(L)+P1(L)
00632 ENDDO
00633 ENDIF
00634 ENDIF
00635
00636
00637
00638
00639 IF (ABS(IDFP2).GE.20) THEN
00640 DO L=1,4
00641 PH(L)=P2(L)
00642 ENDDO
00643 xm1=abs((PD1(4)+PH(4))**2-(PD1(3)+PH(3))**2
00644 $ -(PD1(2)+PH(2))**2-(PD1(1)+PH(1))**2)
00645 xm2=abs((PD2(4)+PH(4))**2-(PD2(3)+PH(3))**2
00646 $ -(PD2(2)+PH(2))**2-(PD2(1)+PH(1))**2)
00647 IF (XM1.LT.XM2) THEN
00648 DO L=1,4
00649 PD1(L)=PD1(L)+P2(L)
00650 ENDDO
00651 ELSE
00652 DO L=1,4
00653 PD2(L)=PD2(L)+P2(L)
00654 ENDDO
00655 ENDIF
00656 ENDIF
00657
00658
00659
00660
00661 NPH1=NP1
00662 NPH2=NP2
00663 IF (IDHEP(JMOHEP(1,NP1)).EQ.IDHEP(NP1)) NPH1=JMOHEP(1,NP1)
00664 IF (IDHEP(JMOHEP(1,NP2)).EQ.IDHEP(NP2)) NPH2=JMOHEP(1,NP2)
00665
00666
00667 DO k=NX1,NX2
00668 IF (ABS(IDHEP(K)).NE.IFLAV.AND.K.NE.IM.AND.
00669
00670 $ K.NE.NPH1.AND.K.NE.NPH2) THEN
00671
00672 IF(IDHEP(K).EQ.22.AND.IFFULL.EQ.1) THEN
00673 DO L=1,4
00674 PH(L)=PHEP(L,K)
00675 ENDDO
00676 xm1=abs((PD1(4)-PH(4))**2-(PD1(3)-PH(3))**2
00677 $ -(PD1(2)-PH(2))**2-(PD1(1)-PH(1))**2)
00678 xm2=abs((PD2(4)-PH(4))**2-(PD2(3)-PH(3))**2
00679 $ -(PD2(2)-PH(2))**2-(PD2(1)-PH(1))**2)
00680 xm3=abs((PQ1(4)+PH(4))**2-(PQ1(3)+PH(3))**2
00681 $ -(PQ1(2)+PH(2))**2-(PQ1(1)+PH(1))**2)
00682 xm4=abs((PQ2(4)+PH(4))**2-(PQ2(3)+PH(3))**2
00683 $ -(PQ2(2)+PH(2))**2-(PQ2(1)+PH(1))**2)
00684
00685
00686 sini=abs((PD1(4)+PD2(4)-PH(4))**2-(PD1(3)+PD2(3)-PH(3))**2
00687 $ -(PD1(2)+PD2(2)-PH(2))**2-(PD1(1)+PD2(1)-PH(1))**2)
00688 sfin=abs((PD1(4)+PD2(4) )**2-(PD1(3)+PD2(3) )**2
00689 $ -(PD1(2)+PD2(2) )**2-(PD1(1)+PD2(1) )**2)
00690
00691 FACINI=ZPROP2(sini)
00692 FACFIN=ZPROP2(sfin)
00693
00694 XM1=XM1/FACINI
00695 XM2=XM2/FACINI
00696 XM3=XM3/FACFIN
00697 XM4=XM4/FACFIN
00698
00699 XM=MIN(XM1,XM2,XM3,XM4)
00700 IF (XM1.EQ.XM) THEN
00701 DO L=1,4
00702 PD1(L)=PD1(L)-PH(L)
00703 ENDDO
00704 ELSEIF (XM2.EQ.XM) THEN
00705 DO L=1,4
00706 PD2(L)=PD2(L)-PH(L)
00707 ENDDO
00708 ELSEIF (XM3.EQ.XM) THEN
00709 DO L=1,4
00710 Q1(L)=PQ1(L)+PH(L)
00711 ENDDO
00712 ELSE
00713 DO L=1,4
00714 Q2(L)=PQ2(L)+PH(L)
00715 ENDDO
00716 ENDIF
00717 ELSE
00718 DO L=1,4
00719 PH(L)=PHEP(L,K)
00720 ENDDO
00721 xm1=abs((PD1(4)-PH(4))**2-(PD1(3)-PH(3))**2
00722 $ -(PD1(2)-PH(2))**2-(PD1(1)-PH(1))**2)
00723 xm2=abs((PD2(4)-PH(4))**2-(PD2(3)-PH(3))**2
00724 $ -(PD2(2)-PH(2))**2-(PD2(1)-PH(1))**2)
00725 IF (XM1.LT.XM2) THEN
00726 DO L=1,4
00727 PD1(L)=PD1(L)-PH(L)
00728 ENDDO
00729 ELSE
00730 DO L=1,4
00731 PD2(L)=PD2(L)-PH(L)
00732 ENDDO
00733 ENDIF
00734 ENDIF
00735 ENDIF
00736 ENDDO
00737
00738
00739
00740
00741
00742
00743
00744
00745
00746
00747
00748
00749
00750
00751
00752
00753
00754 IF (ABS(IDHEP(IM0)).EQ.22.OR.abs(IDHEP(IM0)).EQ.23) THEN
00755 DO K=ISON(1),ISON(2)
00756 IF(ABS(IDHEP(K)).EQ.22) THEN
00757
00758
00759 do l=1,4
00760 ph(l)=phep(l,k)
00761 enddo
00762
00763 xm3=abs((PQ1(4)+PH(4))**2-(PQ1(3)+PH(3))**2
00764 $ -(PQ1(2)+PH(2))**2-(PQ1(1)+PH(1))**2)
00765 xm4=abs((PQ2(4)+PH(4))**2-(PQ2(3)+PH(3))**2
00766 $ -(PQ2(2)+PH(2))**2-(PQ2(1)+PH(1))**2)
00767
00768 XM=MIN(XM3,XM4)
00769
00770 IF (XM3.EQ.XM) THEN
00771 DO L=1,4
00772 Q1(L)=PQ1(L)+PH(L)
00773 ENDDO
00774 ELSE
00775 DO L=1,4
00776 Q2(L)=PQ2(L)+PH(L)
00777 ENDDO
00778 ENDIF
00779 endif
00780 enddo
00781 ENDIF
00782
00783
00784
00785
00786
00787
00788
00789 CALL ANGULU(PD1,PD2,Q1,Q2,COSTHE)
00790
00791 PLZAPX=PLZAP0(IDE,IDFQ1,SVAR,COSTHE)
00792 END
00793
00794 SUBROUTINE ANGULU(PD1,PD2,Q1,Q2,COSTHE)
00795 REAL*8 PD1(4),PD2(4),Q1(4),Q2(4),COSTHE,P(4),QQ(4),QT(4)
00796
00797
00798
00799
00800
00801 XM1=ABS(PD1(4)**2-PD1(3)**2-PD1(2)**2-PD1(1)**2)
00802 XM2=ABS(PD2(4)**2-PD2(3)**2-PD2(2)**2-PD2(1)**2)
00803 IF (XM1.LT.XM2) THEN
00804 SIGN=1D0
00805 DO K=1,4
00806 P(K)=PD1(K)
00807 ENDDO
00808 ELSE
00809 SIGN=-1D0
00810 DO K=1,4
00811 P(K)=PD2(K)
00812 ENDDO
00813 ENDIF
00814
00815 DO K=1,4
00816 QQ(K)=Q1(k)+Q2(K)
00817 QT(K)=Q1(K)-Q2(K)
00818 ENDDO
00819
00820 XMQQ=SQRT(QQ(4)**2-QQ(3)**2-QQ(2)**2-QQ(1)**2)
00821
00822 QTXQQ=QT(4)*QQ(4)-QT(3)*QQ(3)-QT(2)*QQ(2)-QT(1)*QQ(1)
00823 DO K=1,4
00824 QT(K)=QT(K)-QQ(K)*QTXQQ/XMQQ**2
00825 ENDDO
00826
00827 PXQQ=P(4)*QQ(4)-P(3)*QQ(3)-P(2)*QQ(2)-P(1)*QQ(1)
00828 DO K=1,4
00829 P(K)=P(K)-QQ(K)*PXQQ/XMQQ**2
00830 ENDDO
00831
00832 PXP =SQRT(p(1)**2+p(2)**2+p(3)**2-p(4)**2)
00833 QTXQT=SQRT(QT(3)**2+QT(2)**2+QT(1)**2-QT(4)**2)
00834 PXQT =P(3)*QT(3)+P(2)*QT(2)+P(1)*QT(1)-P(4)*QT(4)
00835 COSTHE=PXQT/PXP/QTXQT
00836 COSTHE=COSTHE*SIGN
00837 END
00838
00839 FUNCTION PLZAP0(IDE,IDF,SVAR,COSTH0)
00840
00841
00842 REAL*8 PLZAP0,SVAR,COSTHE,COSTH0,T_BORN
00843
00844 COSTHE=COSTH0
00845
00846
00847
00848 IF (IDF.GT.0) THEN
00849 CALL INITWK(IDE,IDF,SVAR)
00850 ELSE
00851 CALL INITWK(-IDE,-IDF,SVAR)
00852 ENDIF
00853 PLZAP0=T_BORN(0,SVAR,COSTHE,1D0,1D0)
00854 $ /(T_BORN(0,SVAR,COSTHE,1D0,1D0)+T_BORN(0,SVAR,COSTHE,-1D0,-1D0))
00855
00856
00857 END
00858 FUNCTION T_BORN(MODE,SVAR,COSTHE,TA,TB)
00859
00860
00861
00862
00863
00864
00865
00866
00867
00868
00869 IMPLICIT REAL*8(A-H,O-Z)
00870 COMMON / T_BEAMPM / ENE ,AMIN,AMFIN,IDE,IDF
00871 REAL*8 ENE ,AMIN,AMFIN
00872 COMMON / T_GAUSPM /SS,POLN,T3E,QE,T3F,QF
00873 & ,XUPGI ,XUPZI ,XUPGF ,XUPZF
00874 & ,NDIAG0,NDIAGA,KEYA,KEYZ
00875 & ,ITCE,JTCE,ITCF,JTCF,KOLOR
00876 REAL*8 SS,POLN,T3E,QE,T3F,QF
00877 & ,XUPGI(2),XUPZI(2),XUPGF(2),XUPZF(2)
00878 REAL*8 SEPS1,SEPS2
00879
00880 COMMON / T_GSWPRM /SWSQ,AMW,AMZ,AMH,AMTOP,GAMMZ
00881 REAL*8 SWSQ,AMW,AMZ,AMH,AMTOP,GAMMZ
00882
00883
00884
00885
00886
00887 COMPLEX*16 ABORN(2,2),APHOT(2,2),AZETT(2,2)
00888 COMPLEX*16 XUPZFP(2),XUPZIP(2)
00889 COMPLEX*16 ABORNM(2,2),APHOTM(2,2),AZETTM(2,2)
00890 COMPLEX*16 PROPA,PROPZ
00891 COMPLEX*16 XR,XI
00892 COMPLEX*16 XUPF,XUPI,XFF(4),XFEM,XFOTA,XRHO,XKE,XKF,XKEF
00893 COMPLEX*16 XTHING,XVE,XVF,XVEF
00894 DATA XI/(0.D0,1.D0)/,XR/(1.D0,0.D0)/
00895 DATA MODE0 /-5/
00896 DATA IDE0 /-55/
00897 DATA SVAR0,COST0 /-5.D0,-6.D0/
00898 DATA PI /3.141592653589793238462643D0/
00899 DATA SEPS1,SEPS2 /0D0,0D0/
00900
00901
00902 IF ( MODE.NE.MODE0.OR.SVAR.NE.SVAR0.OR.COSTHE.NE.COST0
00903 $ .OR.IDE0.NE.IDE)THEN
00904
00905 KEYGSW=1
00906
00907 IDE0=IDE
00908 MODE0=MODE
00909 SVAR0=SVAR
00910 COST0=COSTHE
00911 SINTHE=SQRT(1.D0-COSTHE**2)
00912 BETA=SQRT(MAX(0D0,1D0-4D0*AMFIN**2/SVAR))
00913
00914 XUPZFP(1)=0.5D0*(XUPZF(1)+XUPZF(2))+0.5*BETA*(XUPZF(1)-XUPZF(2))
00915 XUPZFP(2)=0.5D0*(XUPZF(1)+XUPZF(2))-0.5*BETA*(XUPZF(1)-XUPZF(2))
00916 XUPZIP(1)=0.5D0*(XUPZI(1)+XUPZI(2))+0.5*(XUPZI(1)-XUPZI(2))
00917 XUPZIP(2)=0.5D0*(XUPZI(1)+XUPZI(2))-0.5*(XUPZI(1)-XUPZI(2))
00918
00919 XUPF =0.5D0*(XUPZF(1)+XUPZF(2))
00920 XUPI =0.5D0*(XUPZI(1)+XUPZI(2))
00921 XTHING =0D0
00922
00923 PROPA =1D0/SVAR
00924 PROPZ =1D0/DCMPLX(SVAR-AMZ**2,SVAR/AMZ*GAMMZ)
00925 IF (KEYGSW.EQ.0) PROPZ=0.D0
00926 DO 50 I=1,2
00927 DO 50 J=1,2
00928 REGULA= (3-2*I)*(3-2*J) + COSTHE
00929 REGULM=-(3-2*I)*(3-2*J) * SINTHE *2.D0*AMFIN/SQRT(SVAR)
00930 APHOT(I,J)=PROPA*(XUPGI(I)*XUPGF(J)*REGULA)
00931 AZETT(I,J)=PROPZ*(XUPZIP(I)*XUPZFP(J)+XTHING)*REGULA
00932 ABORN(I,J)=APHOT(I,J)+AZETT(I,J)
00933 APHOTM(I,J)=PROPA*DCMPLX(0D0,1D0)*XUPGI(I)*XUPGF(J)*REGULM
00934 AZETTM(I,J)=PROPZ*DCMPLX(0D0,1D0)*(XUPZIP(I)*XUPF+XTHING)*REGULM
00935 ABORNM(I,J)=APHOTM(I,J)+AZETTM(I,J)
00936 50 CONTINUE
00937 ENDIF
00938
00939
00940
00941
00942
00943 POLAR1= (SEPS1)
00944 POLAR2= (-SEPS2)
00945 BORN=0D0
00946 DO 150 I=1,2
00947 HELIC= 3-2*I
00948 DO 150 J=1,2
00949 HELIT=3-2*J
00950 FACTOR=KOLOR*(1D0+HELIC*POLAR1)*(1D0-HELIC*POLAR2)/4D0
00951 FACTOM=FACTOR*(1+HELIT*TA)*(1-HELIT*TB)
00952 FACTOR=FACTOR*(1+HELIT*TA)*(1+HELIT*TB)
00953
00954 BORN=BORN+CDABS(ABORN(I,J))**2*FACTOR
00955
00956 IF (MODE.GE.1) THEN
00957 BORN=BORN+CDABS(ABORNM(I,J))**2*FACTOM
00958 ENDIF
00959
00960 150 CONTINUE
00961
00962 FUNT=BORN
00963 IF(FUNT.LT.0.D0) FUNT=BORN
00964
00965
00966 IF (SVAR.GT.4D0*AMFIN**2) THEN
00967
00968 THRESH=SQRT(1-4D0*AMFIN**2/SVAR)
00969 T_BORN= FUNT*SVAR**2*THRESH
00970 ELSE
00971 THRESH=0.D0
00972 T_BORN=0.D0
00973 ENDIF
00974
00975
00976
00977 END
00978
00979 SUBROUTINE INITWK(IDEX,IDFX,SVAR)
00980
00981 IMPLICIT REAL*8 (A-H,O-Z)
00982 COMMON / T_BEAMPM / ENE ,AMIN,AMFIN,IDE,IDF
00983 REAL*8 ENE ,AMIN,AMFIN
00984 COMMON / T_GAUSPM /SS,POLN,T3E,QE,T3F,QF
00985 & ,XUPGI ,XUPZI ,XUPGF ,XUPZF
00986 & ,NDIAG0,NDIAGA,KEYA,KEYZ
00987 & ,ITCE,JTCE,ITCF,JTCF,KOLOR
00988 REAL*8 SS,POLN,T3E,QE,T3F,QF
00989 & ,XUPGI(2),XUPZI(2),XUPGF(2),XUPZF(2)
00990 COMMON / T_GSWPRM /SWSQ,AMW,AMZ,AMH,AMTOP,GAMMZ
00991 REAL*8 SWSQ,AMW,AMZ,AMH,AMTOP,GAMMZ
00992
00993
00994
00995
00996
00997
00998 ENE=SQRT(SVAR)/2
00999 AMIN=0.511D-3
01000 SWSQ=0.23147
01001 AMZ=91.1882
01002 GAMMZ=2.4952
01003 IF (IDFX.EQ. 15) then
01004 IDF=2
01005 AMFIN=1.77703
01006 ELSEIF (IDFX.EQ.-15) then
01007 IDF=-2
01008 AMFIN=1.77703
01009 ELSE
01010 WRITE(*,*) 'INITWK: WRONG IDFX'
01011 STOP
01012 ENDIF
01013
01014 IF (IDEX.EQ. 11) then
01015 IDE= 2
01016 AMIN=0.511D-3
01017 ELSEIF (IDEX.EQ.-11) then
01018 IDE=-2
01019 AMIN=0.511D-3
01020 ELSEIF (IDEX.EQ. 13) then
01021 IDE= 2
01022 AMIN=0.105659
01023 ELSEIF (IDEX.EQ.-13) then
01024 IDE=-2
01025 AMIN=0.105659
01026 ELSEIF (IDEX.EQ. 1) then
01027 IDE= 4
01028 AMIN=0.05
01029 ELSEIF (IDEX.EQ.- 1) then
01030 IDE=-4
01031 AMIN=0.05
01032 ELSEIF (IDEX.EQ. 2) then
01033 IDE= 3
01034 AMIN=0.02
01035 ELSEIF (IDEX.EQ.- 2) then
01036 IDE=-3
01037 AMIN=0.02
01038 ELSEIF (IDEX.EQ. 3) then
01039 IDE= 4
01040 AMIN=0.3
01041 ELSEIF (IDEX.EQ.- 3) then
01042 IDE=-4
01043 AMIN=0.3
01044 ELSEIF (IDEX.EQ. 4) then
01045 IDE= 3
01046 AMIN=1.3
01047 ELSEIF (IDEX.EQ.- 4) then
01048 IDE=-3
01049 AMIN=1.3
01050 ELSEIF (IDEX.EQ. 5) then
01051 IDE= 4
01052 AMIN=4.5
01053 ELSEIF (IDEX.EQ.- 5) then
01054 IDE=-4
01055 AMIN=4.5
01056 ELSEIF (IDEX.EQ. 12) then
01057 IDE= 1
01058 AMIN=0.1D-3
01059 ELSEIF (IDEX.EQ.- 12) then
01060 IDE=-1
01061 AMIN=0.1D-3
01062 ELSEIF (IDEX.EQ. 14) then
01063 IDE= 1
01064 AMIN=0.1D-3
01065 ELSEIF (IDEX.EQ.- 14) then
01066 IDE=-1
01067 AMIN=0.1D-3
01068 ELSEIF (IDEX.EQ. 16) then
01069 IDE= 1
01070 AMIN=0.1D-3
01071 ELSEIF (IDEX.EQ.- 16) then
01072 IDE=-1
01073 AMIN=0.1D-3
01074
01075 ELSE
01076 WRITE(*,*) 'INITWK: WRONG IDEX'
01077 STOP
01078 ENDIF
01079
01080
01081
01082
01083
01084
01085
01086 ITCE=IDE/IABS(IDE)
01087 JTCE=(1-ITCE)/2
01088 ITCF=IDF/IABS(IDF)
01089 JTCF=(1-ITCF)/2
01090 CALL T_GIVIZO( IDE, 1,AIZOR,QE,KDUMM)
01091 CALL T_GIVIZO( IDE,-1,AIZOL,QE,KDUMM)
01092 XUPGI(1)=QE
01093 XUPGI(2)=QE
01094 T3E = AIZOL+AIZOR
01095 XUPZI(1)=(AIZOR-QE*SWSQ)/SQRT(SWSQ*(1-SWSQ))
01096 XUPZI(2)=(AIZOL-QE*SWSQ)/SQRT(SWSQ*(1-SWSQ))
01097 CALL T_GIVIZO( IDF, 1,AIZOR,QF,KOLOR)
01098 CALL T_GIVIZO( IDF,-1,AIZOL,QF,KOLOR)
01099 XUPGF(1)=QF
01100 XUPGF(2)=QF
01101 T3F = AIZOL+AIZOR
01102 XUPZF(1)=(AIZOR-QF*SWSQ)/SQRT(SWSQ*(1-SWSQ))
01103 XUPZF(2)=(AIZOL-QF*SWSQ)/SQRT(SWSQ*(1-SWSQ))
01104
01105 NDIAG0=2
01106 NDIAGA=11
01107 KEYA = 1
01108 KEYZ = 1
01109
01110
01111 RETURN
01112 END
01113
01114 SUBROUTINE T_GIVIZO(IDFERM,IHELIC,SIZO3,CHARGE,KOLOR)
01115
01116
01117
01118
01119
01120
01121
01122
01123
01124
01125
01126 IMPLICIT REAL*8(A-H,O-Z)
01127
01128 IF(IDFERM.EQ.0.OR.IABS(IDFERM).GT.4) GOTO 901
01129 IF(IABS(IHELIC).NE.1) GOTO 901
01130 IH =IHELIC
01131 IDTYPE =IABS(IDFERM)
01132 IC =IDFERM/IDTYPE
01133 LEPQUA=INT(IDTYPE*0.4999999D0)
01134 IUPDOW=IDTYPE-2*LEPQUA-1
01135 CHARGE =(-IUPDOW+2D0/3D0*LEPQUA)*IC
01136 SIZO3 =0.25D0*(IC-IH)*(1-2*IUPDOW)
01137 KOLOR=1+2*LEPQUA
01138
01139
01140 RETURN
01141 901 PRINT *,' STOP IN GIVIZO: WRONG PARAMS.'
01142 STOP
01143 END
01144 #include "../../include/phyfix.h"
01145 SUBROUTINE FILHEP(N,IST,ID,JMO1,JMO2,JDA1,JDA2,P4,PINV,PHFLAG)
01146
01147
01148
01149
01150
01151
01152
01153
01154
01155
01156 #include "../../include/HEPEVT.h"
01157 LOGICAL PHFLAG
01158
01159 REAL*4 P4(4)
01160
01161
01162 IF (N.EQ.0) THEN
01163
01164
01165 IHEP=NHEP+1
01166 ELSE IF (N.GT.0) THEN
01167
01168
01169 IHEP=N
01170 ELSE
01171
01172
01173 IHEP=NHEP+N
01174 END IF
01175
01176
01177 IF ((IHEP.LE.0).OR.(IHEP.GT.NMXHEP)) RETURN
01178
01179
01180 NHEP=IHEP
01181 ISTHEP(IHEP)=IST
01182 IDHEP(IHEP)=ID
01183 JMOHEP(1,IHEP)=JMO1
01184 IF(JMO1.LT.0)JMOHEP(1,IHEP)=JMOHEP(1,IHEP)+IHEP
01185 JMOHEP(2,IHEP)=JMO2
01186 IF(JMO2.LT.0)JMOHEP(2,IHEP)=JMOHEP(2,IHEP)+IHEP
01187 JDAHEP(1,IHEP)=JDA1
01188 JDAHEP(2,IHEP)=JDA2
01189
01190 DO I=1,4
01191 PHEP(I,IHEP)=P4(I)
01192
01193
01194 VHEP(I,IHEP)=0.0
01195 END DO
01196 PHEP(5,IHEP)=PINV
01197
01198 QEDRAD(IHEP)=PHFLAG
01199
01200
01201 DO IP=JMOHEP(1,IHEP),JMOHEP(2,IHEP)
01202 IF(IP.GT.0)THEN
01203
01204
01205 IF(ISTHEP(IP).EQ.1)ISTHEP(IP)=2
01206
01207
01208 IF(JDAHEP(1,IP).EQ.0)THEN
01209 JDAHEP(1,IP)=IHEP
01210 JDAHEP(2,IP)=IHEP
01211 ELSE
01212 JDAHEP(2,IP)=MAX(IHEP,JDAHEP(2,IP))
01213 END IF
01214 END IF
01215 END DO
01216
01217 RETURN
01218 END
01219
01220
01221 FUNCTION IHEPDIM(DUM)
01222
01223 #include "../../include/HEPEVT.h"
01224 IHEPDIM=NHEP
01225 END
01226 FUNCTION ZPROP2(S)
01227 IMPLICIT REAL*8(A-H,O-Z)
01228 COMPLEX*16 CPRZ0,CPRZ0M
01229 AMZ=91.1882
01230 GAMMZ=2.49
01231 CPRZ0=DCMPLX((S-AMZ**2),S/AMZ*GAMMZ)
01232 CPRZ0M=1/CPRZ0
01233 ZPROP2=(ABS(CPRZ0M))**2
01234 END
01235
01236 SUBROUTINE TAUPI0(MODE,JAK,ION)
01237
01238
01239
01240
01241
01242
01243
01244
01245
01246
01247
01248 #include "../../include/HEPEVT.h"
01249
01250
01251 COMMON /TAUPOS/ NP1,NP2
01252
01253 REAL PHOT1(4),PHOT2(4)
01254 REAL*8 R,X(4),Y(4),PI0(4)
01255 INTEGER JEZELI(3),ION(3)
01256 DATA JEZELI /0,0,0/
01257 SAVE JEZELI
01258 IF (MODE.EQ.-1) THEN
01259 JEZELI(1)=ION(1)
01260 JEZELI(2)=ION(2)
01261 JEZELI(3)=ION(3)
01262 RETURN
01263 ENDIF
01264 IF (JEZELI(1).EQ.0) RETURN
01265 IF (JEZELI(2).EQ.1) CALL TAUETA(JAK)
01266 IF (JEZELI(3).EQ.1) CALL TAUK0S(JAK)
01267
01268 IF((KTO.EQ. 1).OR.(KTO.EQ.11)) THEN
01269 NPS=NP1
01270 ELSE
01271 NPS=NP2
01272 ENDIF
01273 nhepM=nhep
01274 DO K=JDAHEP(1,NPS),nhepM
01275 IF (IDHEP(K).EQ.111.AND.JDAHEP(1,K).LE.K) THEN
01276 DO L=1,4
01277 PI0(L)= phep(L,K)
01278 ENDDO
01279
01280 R=SQRT(PI0(4)**2-PI0(3)**2-PI0(2)**2-PI0(1)**2)/2D0
01281 CALL SPHERD(R,X)
01282 X(4)=R
01283 Y(4)=R
01284
01285 Y(1)=-X(1)
01286 Y(2)=-X(2)
01287 Y(3)=-X(3)
01288
01289 CALL bostdq(-1,PI0,X,X)
01290 CALL bostdq(-1,PI0,Y,Y)
01291 DO L=1,4
01292 PHOT1(L)=X(L)
01293 PHOT2(L)=Y(L)
01294 ENDDO
01295
01296 CALL FILHEP(0,1,22,K,K,0,0,PHOT1,0.0,.TRUE.)
01297 CALL FILHEP(0,1,22,K,K,0,0,PHOT2,0.0,.TRUE.)
01298 ENDIF
01299 ENDDO
01300
01301 END
01302 SUBROUTINE TAUETA(JAK)
01303
01304
01305
01306
01307
01308 #include "../../include/HEPEVT.h"
01309 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
01310 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
01311 * ,AMK,AMKZ,AMKST,GAMKST
01312
01313 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
01314 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
01315 * ,AMK,AMKZ,AMKST,GAMKST
01316
01317
01318 COMMON /TAUPOS/ NP1,NP2
01319
01320 REAL RRR(1),BRSUM(3), RR(2)
01321 REAL PHOT1(4),PHOT2(4),PHOT3(4)
01322 REAL*8 X(4), Y(4), Z(4)
01323 REAL YM1,YM2,YM3
01324 REAL*8 R,RU,PETA(4),XM1,XM2,XM3,XM,XLAM
01325 REAL*8 a,b,c
01326 XLAM(a,b,c)=SQRT(ABS((a-b-c)**2-4.0*b*c))
01327
01328 IF((KTO.EQ. 1).OR.(KTO.EQ.11)) THEN
01329 NPS=NP1
01330 ELSE
01331 NPS=NP2
01332 ENDIF
01333 nhepM=nhep
01334 DO K=JDAHEP(1,NPS),nhepM
01335 IF (IDHEP(K).EQ.221.AND.JDAHEP(1,K).LE.K) THEN
01336 DO L=1,4
01337 PETA(L)= phep(L,K)
01338 ENDDO
01339
01340 BRSUM(1)=0.389
01341 BRSUM(2)=BRSUM(1)+0.319
01342 BRSUM(3)=BRSUM(2)+0.237
01343 CALL RANMAR(RRR,1)
01344
01345 IF (RRR(1).LT.BRSUM(1)) THEN
01346
01347 R=SQRT(PETA(4)**2-PETA(3)**2-PETA(2)**2-PETA(1)**2)/2D0
01348 CALL SPHERD(R,X)
01349 X(4)=R
01350 Y(4)=R
01351
01352 Y(1)=-X(1)
01353 Y(2)=-X(2)
01354 Y(3)=-X(3)
01355
01356 CALL bostdq(-1,PETA,X,X)
01357 CALL bostdq(-1,PETA,Y,Y)
01358 DO L=1,4
01359 PHOT1(L)=X(L)
01360 PHOT2(L)=Y(L)
01361 ENDDO
01362
01363 CALL FILHEP(0,1,22,K,K,0,0,PHOT1,0.0,.TRUE.)
01364 CALL FILHEP(0,1,22,K,K,0,0,PHOT2,0.0,.TRUE.)
01365 ELSE
01366 IF(RRR(1).LT.BRSUM(2)) THEN
01367 ID1= 111
01368 ID2= 111
01369 ID3= 111
01370 XM1=AMPIZ
01371 XM2=AMPIZ
01372 XM3=AMPIZ
01373 ELSEIF(RRR(1).LT.BRSUM(3)) THEN
01374 ID1= 211
01375 ID2=-211
01376 ID3= 111
01377 XM1=AMPI
01378 XM2=AMPI
01379 XM3=AMPIZ
01380 ELSE
01381 ID1= 211
01382 ID2=-211
01383 ID3= 22
01384 XM1=AMPI
01385 XM2=AMPI
01386 XM3=0.0
01387 ENDIF
01388 7 CONTINUE
01389 CALL RANMAR(RR,2)
01390 R=SQRT(PETA(4)**2-PETA(3)**2-PETA(2)**2-PETA(1)**2)
01391 AMIN=XM1+XM2
01392 AMAX=R-XM3
01393 AM2=SQRT(AMIN**2+RR(1)*(AMAX**2-AMIN**2))
01394
01395 WT=XLAM(1D0*R**2,1D0*AM2**2,1D0*XM3**2)
01396 & *XLAM(1D0*AM2**2,1D0*XM1**2,1D0*XM2**2)
01397 & /R**2 /AM2**2
01398 IF (RR(2).GT.WT) GOTO 7
01399
01400 RU=XLAM(1D0*AM2**2,1D0*XM1**2,1D0*XM2**2)/AM2/2
01401
01402
01403 CALL SPHERD(RU,X)
01404 X(4)=SQRT(RU**2+XM1**2)
01405 Y(4)=SQRT(RU**2+XM2**2)
01406
01407 Y(1)=-X(1)
01408 Y(2)=-X(2)
01409 Y(3)=-X(3)
01410
01411 RU=XLAM(1D0*R**2,1D0*AM2**2,1D0*XM3**2)/R/2
01412 CALL SPHERD(RU,Z)
01413 Z(4)=SQRT(RU**2+AM2**2)
01414
01415 CALL bostdq(-1,Z,X,X)
01416 CALL bostdq(-1,Z,Y,Y)
01417
01418 Z(1)=-Z(1)
01419 Z(2)=-Z(2)
01420 Z(3)=-Z(3)
01421 Z(4)=SQRT(RU**2+XM3**2)
01422
01423 CALL bostdq(-1,PETA,X,X)
01424 CALL bostdq(-1,PETA,Y,Y)
01425 CALL bostdq(-1,PETA,Z,Z)
01426 DO L=1,4
01427 PHOT1(L)=X(L)
01428 PHOT2(L)=Y(L)
01429 PHOT3(L)=Z(L)
01430 ENDDO
01431 YM1=XM1
01432 YM2=XM2
01433 YM3=XM3
01434
01435 CALL FILHEP(0,1,ID1,K,K,0,0,PHOT1,YM1,.TRUE.)
01436 CALL FILHEP(0,1,ID2,K,K,0,0,PHOT2,YM2,.TRUE.)
01437 CALL FILHEP(0,1,ID3,K,K,0,0,PHOT3,YM3,.TRUE.)
01438 ENDIF
01439
01440 ENDIF
01441 ENDDO
01442
01443 END
01444 SUBROUTINE TAUK0S(JAK)
01445
01446
01447
01448
01449
01450 #include "../../include/HEPEVT.h"
01451
01452 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
01453 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
01454 * ,AMK,AMKZ,AMKST,GAMKST
01455
01456 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
01457 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
01458 * ,AMK,AMKZ,AMKST,GAMKST
01459
01460
01461 COMMON /TAUPOS/ NP1,NP2
01462
01463 REAL RRR(1),BRSUM(3), RR(2)
01464 REAL PHOT1(4),PHOT2(4),PHOT3(4)
01465 REAL*8 X(4), Y(4), Z(4)
01466 REAL YM1,YM2,YM3
01467 REAL*8 R,RU,PETA(4),XM1,XM2,XM3,XM,XLAM
01468 REAL*8 a,b,c
01469 XLAM(a,b,c)=SQRT(ABS((a-b-c)**2-4.0*b*c))
01470
01471 IF((KTO.EQ. 1).OR.(KTO.EQ.11)) THEN
01472 NPS=NP1
01473 ELSE
01474 NPS=NP2
01475 ENDIF
01476 nhepM=nhep
01477 DO K=JDAHEP(1,NPS),nhepM
01478 IF (IDHEP(K).EQ.310.AND.JDAHEP(1,K).LE.K) THEN
01479
01480
01481 DO L=1,4
01482 PETA(L)= phep(L,K)
01483 ENDDO
01484
01485 BRSUM(1)=0.313
01486 BRSUM(2)=1.0
01487 BRSUM(3)=BRSUM(2)+0.237
01488 CALL RANMAR(RRR,1)
01489
01490 IF(RRR(1).LT.BRSUM(1)) THEN
01491 ID1= 111
01492 ID2= 111
01493 XM1=AMPIZ
01494 XM2=AMPIZ
01495 ELSEIF(RRR(1).LT.BRSUM(2)) THEN
01496 ID1= 211
01497 ID2=-211
01498 XM1=AMPI
01499 XM2=AMPI
01500 ELSE
01501 ID1= 22
01502 ID2= 22
01503 XM1= 0.0
01504 XM2= 0.0
01505 ENDIF
01506
01507
01508 R=SQRT(PETA(4)**2-PETA(3)**2-PETA(2)**2-PETA(1)**2)/2D0
01509 R4=R
01510 R=SQRT(ABS(R**2-XM1**2))
01511 CALL SPHERD(R,X)
01512 X(4)=R4
01513 Y(4)=R4
01514
01515 Y(1)=-X(1)
01516 Y(2)=-X(2)
01517 Y(3)=-X(3)
01518
01519 CALL bostdq(-1,PETA,X,X)
01520 CALL bostdq(-1,PETA,Y,Y)
01521 DO L=1,4
01522 PHOT1(L)=X(L)
01523 PHOT2(L)=Y(L)
01524 ENDDO
01525
01526 YM1=XM1
01527 YM2=XM2
01528
01529 CALL FILHEP(0,1,ID1,K,K,0,0,PHOT1,YM1,.TRUE.)
01530 CALL FILHEP(0,1,ID2,K,K,0,0,PHOT2,YM2,.TRUE.)
01531
01532
01533 ENDIF
01534 ENDDO
01535
01536 END