00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021 SUBROUTINE INIETC(ITAUXPAR,xpar)
00022 INCLUDE "BXformat.h"
00023 REAL*8 xpar(*)
00024 INTEGER INUT,IOUT
00025 COMMON /INOUT/
00026 $ INUT,
00027 $ IOUT
00028 COMMON / IDFC / IDFF
00029 COMMON / TAURAD / XK0DEC,ITDKRC
00030 DOUBLE PRECISION XK0DEC
00031 COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM
00032
00033 INTEGER KeyA1
00034 COMMON /TESTA1/
00035 $ KeyA1
00036
00037
00038
00039
00040
00041
00042
00043 SAVE
00044 idff = xpar(ITAUXPAR+3)
00045
00046 xk0dec = xpar(ITAUXPAR+5)
00047
00048 itdkRC = xpar(ITAUXPAR+4)
00049
00050 Jak1 = xpar(ITAUXPAR+1)
00051 Jak2 = xpar(ITAUXPAR+2)
00052
00053 IOUT = xpar(4)
00054
00055 KeyA1 = xpar(ITAUXPAR+6)
00056
00057 WRITE(iout,bxope)
00058 WRITE(iout,bxtxt) ' Parameters passed from KK to Tauola: '
00059 WRITE(iout,bxl1i) Jak1, 'dec. type 1-st tau ','Jak1 ','t01'
00060 WRITE(iout,bxl1i) Jak2, 'dec. type 2-nd tau ','Jak2 ','t02'
00061 WRITE(iout,bxl1i) KeyA1, 'current type a1 dec.','KeyA1 ','t03'
00062 WRITE(iout,bxl1i) idff, 'PDG id 1-st tau ','idff ','t04'
00063 WRITE(iout,bxl1i) itdkRC, 'R.c. switch lept dec','itdkRC','t05'
00064 WRITE(iout,bxl1g) xk0dec, 'IR-cut for lept r.c.','xk0dec','t06'
00065 WRITE(iout,bxclo)
00066
00067 end
00068
00069 SUBROUTINE INITDK(ITAUXPAR,xpar)
00070
00071
00072
00073
00074
00075 INCLUDE "BXformat.h"
00076 INTEGER INUT,IOUT
00077 COMMON /INOUT/
00078 $ INUT,
00079 $ IOUT
00080 REAL*8 xpar(*)
00081
00082 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00083 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00084 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00085 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00086 * ,AMK,AMKZ,AMKST,GAMKST
00087
00088 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00089 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00090 * ,AMK,AMKZ,AMKST,GAMKST
00091 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00092 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00093 REAL*4 BRA1,BRK0,BRK0B,BRKS
00094 #if defined (ALEPH)
00095 PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
00096 COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
00097 & ,NAMES
00098 CHARACTER NAMES(NMODE)*31
00099 #else
00100 PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
00101 COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
00102 & ,NAMES
00103 CHARACTER NAMES(NMODE)*31
00104 #endif
00105 CHARACTER OLDNAMES(7)*31
00106 CHARACTER*80 bxINIT
00107 PARAMETER (
00108 $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
00109 $ )
00110 REAL*4 PI,POL1(4)
00111
00112
00113
00114
00115
00116
00117 #if defined (ALEPH)
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164 #else
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177 #endif
00178
00179 DIMENSION NOPIK(6,NMODE),NPIK(NMODE)
00180
00181 DATA NPIK / 4, 4,
00182 1 5, 5,
00183 2 6, 6,
00184 3 3, 3,
00185 4 3, 3,
00186 5 3, 3,
00187 6 3, 3,
00188 7 2 /
00189 #if defined (ALEPH)
00190 DATA NOPIK / -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0,
00191 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
00192 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
00193 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0,
00194 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
00195 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0,
00196 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
00197 #else
00198 DATA NOPIK / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
00199 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
00200 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
00201 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
00202 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
00203 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
00204 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
00205 #endif
00206 #if defined (CLEO)
00207
00208 7 -3,-4, 0, 0, 0, 0 /
00209 #else
00210 7 -3, 4, 0, 0, 0, 0 /
00211 #endif
00212
00213 NCHAN = NMODE + 7
00214 DO 1 I = 1,30
00215 IF (I.LE.NCHAN) THEN
00216 JLIST(I) = I
00217 #if defined (CePeCe)
00218 IF(I.EQ. 1) GAMPRT(I) = 1.0000
00219 IF(I.EQ. 2) GAMPRT(I) = 1.0000
00220 IF(I.EQ. 3) GAMPRT(I) = 1.0000
00221 IF(I.EQ. 4) GAMPRT(I) = 1.0000
00222 IF(I.EQ. 5) GAMPRT(I) = 1.0000
00223 IF(I.EQ. 6) GAMPRT(I) = 1.0000
00224 IF(I.EQ. 7) GAMPRT(I) = 1.0000
00225 IF(I.EQ. 8) GAMPRT(I) = 1.0000
00226 IF(I.EQ. 9) GAMPRT(I) = 1.0000
00227 IF(I.EQ.10) GAMPRT(I) = 1.0000
00228 IF(I.EQ.11) GAMPRT(I) = 1.0000
00229 IF(I.EQ.12) GAMPRT(I) = 1.0000
00230 IF(I.EQ.13) GAMPRT(I) = 1.0000
00231 IF(I.EQ.14) GAMPRT(I) = 1.0000
00232 IF(I.EQ.15) GAMPRT(I) = 1.0000
00233 IF(I.EQ.16) GAMPRT(I) = 1.0000
00234 IF(I.EQ.17) GAMPRT(I) = 1.0000
00235 IF(I.EQ.18) GAMPRT(I) = 1.0000
00236 IF(I.EQ.19) GAMPRT(I) = 1.0000
00237 IF(I.EQ.20) GAMPRT(I) = 1.0000
00238 IF(I.EQ.21) GAMPRT(I) = 1.0000
00239 IF(I.EQ.22) GAMPRT(I) = 1.0000
00240 #elif defined (CLEO)
00241 IF(I.EQ. 1) GAMPRT(I) =0.1800
00242 IF(I.EQ. 2) GAMPRT(I) =0.1751
00243 IF(I.EQ. 3) GAMPRT(I) =0.1110
00244 IF(I.EQ. 4) GAMPRT(I) =0.2515
00245 IF(I.EQ. 5) GAMPRT(I) =0.1790
00246 IF(I.EQ. 6) GAMPRT(I) =0.0071
00247 IF(I.EQ. 7) GAMPRT(I) =0.0134
00248 IF(I.EQ. 8) GAMPRT(I) =0.0450
00249 IF(I.EQ. 9) GAMPRT(I) =0.0100
00250 IF(I.EQ.10) GAMPRT(I) =0.0009
00251 IF(I.EQ.11) GAMPRT(I) =0.0004
00252 IF(I.EQ.12) GAMPRT(I) =0.0003
00253 IF(I.EQ.13) GAMPRT(I) =0.0005
00254 IF(I.EQ.14) GAMPRT(I) =0.0015
00255 IF(I.EQ.15) GAMPRT(I) =0.0015
00256 IF(I.EQ.16) GAMPRT(I) =0.0015
00257 IF(I.EQ.17) GAMPRT(I) =0.0005
00258 IF(I.EQ.18) GAMPRT(I) =0.0050
00259 IF(I.EQ.19) GAMPRT(I) =0.0055
00260 IF(I.EQ.20) GAMPRT(I) =0.0017
00261 IF(I.EQ.21) GAMPRT(I) =0.0013
00262 IF(I.EQ.22) GAMPRT(I) =0.0010
00263 #elif defined (ALEPH)
00264 IF(I.EQ. 1) GAMPRT(I) = 1.0000
00265 IF(I.EQ. 2) GAMPRT(I) = .9732
00266 IF(I.EQ. 3) GAMPRT(I) = .6217
00267 IF(I.EQ. 4) GAMPRT(I) = 1.4221
00268 IF(I.EQ. 5) GAMPRT(I) = 1.0180
00269 IF(I.EQ. 6) GAMPRT(I) = .0405
00270 IF(I.EQ. 7) GAMPRT(I) = .0781
00271 IF(I.EQ. 8) GAMPRT(I) = .2414
00272 IF(I.EQ. 9) GAMPRT(I) = .0601
00273 IF(I.EQ.10) GAMPRT(I) = .0281
00274 IF(I.EQ.11) GAMPRT(I) = .0045
00275 IF(I.EQ.12) GAMPRT(I) = .0010
00276 IF(I.EQ.13) GAMPRT(I) = .0062
00277 IF(I.EQ.14) GAMPRT(I) = .0096
00278 IF(I.EQ.15) GAMPRT(I) = .0169
00279 IF(I.EQ.16) GAMPRT(I) = .0056
00280 IF(I.EQ.17) GAMPRT(I) = .0045
00281 IF(I.EQ.18) GAMPRT(I) = .0219
00282 IF(I.EQ.19) GAMPRT(I) = .0180
00283 IF(I.EQ.20) GAMPRT(I) = .0096
00284 IF(I.EQ.21) GAMPRT(I) = .0088
00285 IF(I.EQ.22) GAMPRT(I) = .0146
00286 #else
00287 #endif
00288 IF(I.EQ. 1) OLDNAMES(I)=' TAU- --> E- '
00289 IF(I.EQ. 2) OLDNAMES(I)=' TAU- --> MU- '
00290 IF(I.EQ. 3) OLDNAMES(I)=' TAU- --> PI- '
00291 IF(I.EQ. 4) OLDNAMES(I)=' TAU- --> PI-, PI0 '
00292 IF(I.EQ. 5) OLDNAMES(I)=' TAU- --> A1- (two subch) '
00293 IF(I.EQ. 6) OLDNAMES(I)=' TAU- --> K- '
00294 IF(I.EQ. 7) OLDNAMES(I)=' TAU- --> K*- (two subch) '
00295 IF(I.EQ. 8) NAMES(I-7)=' TAU- --> 2PI-, PI0, PI+ '
00296 IF(I.EQ. 9) NAMES(I-7)=' TAU- --> 3PI0, PI- '
00297 IF(I.EQ.10) NAMES(I-7)=' TAU- --> 2PI-, PI+, 2PI0 '
00298 IF(I.EQ.11) NAMES(I-7)=' TAU- --> 3PI-, 2PI+, '
00299 IF(I.EQ.12) NAMES(I-7)=' TAU- --> 3PI-, 2PI+, PI0 '
00300 IF(I.EQ.13) NAMES(I-7)=' TAU- --> 2PI-, PI+, 3PI0 '
00301 IF(I.EQ.14) NAMES(I-7)=' TAU- --> K-, PI-, K+ '
00302 IF(I.EQ.15) NAMES(I-7)=' TAU- --> K0, PI-, K0B '
00303 #if defined (ALEPH)
00304 IF(I.EQ.16) NAMES(I-7)=' TAU- --> K- PI0 K0 '
00305 #else
00306 IF(I.EQ.16) NAMES(I-7)=' TAU- --> K-, K0, PI0 '
00307 #endif
00308 IF(I.EQ.17) NAMES(I-7)=' TAU- --> PI0 PI0 K- '
00309 IF(I.EQ.18) NAMES(I-7)=' TAU- --> K- PI- PI+ '
00310 IF(I.EQ.19) NAMES(I-7)=' TAU- --> PI- K0B PI0 '
00311 IF(I.EQ.20) NAMES(I-7)=' TAU- --> ETA PI- PI0 '
00312 IF(I.EQ.21) NAMES(I-7)=' TAU- --> PI- PI0 GAM '
00313 IF(I.EQ.22) NAMES(I-7)=' TAU- --> K- K0 '
00314 ELSE
00315 JLIST(I) = 0
00316 GAMPRT(I) = 0.
00317 ENDIF
00318 1 CONTINUE
00319 DO I=1,NMODE
00320 MULPIK(I)=NPIK(I)
00321 DO J=1,MULPIK(I)
00322 IDFFIN(J,I)=NOPIK(J,I)
00323 ENDDO
00324 ENDDO
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335 BRA1=0.5
00336 BRK0=0.5
00337 BRK0B=0.5
00338 BRKS=0.6667
00339
00340
00341 GFERMI = 1.16637E-5
00342 CCABIB = 0.975
00343 GV = 1.0
00344 GA =-1.0
00345
00346
00347
00348 GFERMI = xpar(32)
00349 IF (XPAR(ITAUXPAR+100+1).GT.-1D0) THEN
00350
00351 CCABIB = XPAR(ITAUXPAR+7)
00352 GV = XPAR(ITAUXPAR+8)
00353 GA = XPAR(ITAUXPAR+9)
00354
00355 BRA1 = XPAR(ITAUXPAR+10)
00356 BRKS = XPAR(ITAUXPAR+11)
00357 BRK0 = XPAR(ITAUXPAR+12)
00358 BRK0B = XPAR(ITAUXPAR+13)
00359 DO K=1,NCHAN
00360 GAMPRT(K)=XPAR(ITAUXPAR+100+K)
00361 ENDDO
00362 ENDIF
00363
00364 SCABIB = SQRT(1.-CCABIB**2)
00365 PI =4.*ATAN(1.)
00366 GAMEL = GFERMI**2*AMTAU**5/(192*PI**3)
00367
00368
00369
00370
00371
00372 SUM=0
00373 DO K=1,NCHAN
00374 SUM=SUM+GAMPRT(K)
00375 ENDDO
00376
00377
00378 WRITE(iout,bxope)
00379 WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INITDK: '
00380 WRITE(iout,bxtxt) ' Adopted to read from KK '
00381 WRITE(iout,bxtxt) ' '
00382 WRITE(iout,bxtxt) ' Choice Probability -- Decay Channel'
00383 DO K=1,7
00384 WRITE(iout,bxINIT) GAMPRT(K)/SUM, OLDNAMES(K),'****','***'
00385 ENDDO
00386 DO K=8,7+NMODE
00387 WRITE(iout,bxINIT) GAMPRT(K)/SUM, NAMES(K-7),'****','***'
00388 ENDDO
00389 WRITE(iout,bxtxt) ' In addition:'
00390 WRITE(iout,bxINIT) GV, 'Vector W-tau-nu coupl. ','****','***'
00391 WRITE(iout,bxINIT) GA, 'Axial W-tau-nu coupl. ','****','***'
00392 WRITE(iout,bxINIT) GFERMI,'Fermi Coupling ','****','***'
00393 WRITE(iout,bxINIT) CCABIB,'cabibo angle ','****','***'
00394 WRITE(iout,bxINIT) BRA1, 'a1 br ratio (massless) ','****','***'
00395 WRITE(iout,bxINIT) BRKS, 'K* br ratio (massless) ','****','***'
00396 WRITE(iout,bxclo)
00397
00398 RETURN
00399 END
00400
00401 SUBROUTINE INIPHY(XK00)
00402
00403
00404
00405
00406 COMMON / QEDPRM /ALFINV,ALFPI,XK0
00407 REAL*8 ALFINV,ALFPI,XK0
00408 REAL*8 PI8,XK00
00409
00410 PI8 = 4.D0*DATAN(1.D0)
00411 ALFINV = 137.03604D0
00412 ALFPI = 1D0/(ALFINV*PI8)
00413 XK0=XK00
00414 END
00415
00416 SUBROUTINE INIMAS(ITAUXPAR,xpar)
00417
00418
00419
00420
00421
00422 INCLUDE "BXformat.h"
00423 INTEGER INUT,IOUT
00424 COMMON /INOUT/
00425 $ INUT,
00426 $ IOUT
00427 REAL*8 xpar(*)
00428 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00429 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00430 * ,AMK,AMKZ,AMKST,GAMKST
00431
00432 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00433 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00434 * ,AMK,AMKZ,AMKST,GAMKST
00435 CHARACTER*80 bxINIT
00436 PARAMETER (
00437 $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
00438 $ )
00439
00440
00441 AMTAU = xpar(656)
00442 AMNUTA = 0.010
00443 AMEL = xpar(616)
00444 AMNUE = 0.0
00445 AMMU = xpar(636)
00446 AMNUMU = 0.0
00447
00448
00449 #if defined (CePeCe)
00450 AMPIZ = 0.134964
00451 AMPI = 0.139568
00452 AMRO = 0.773
00453 GAMRO = 0.145
00454
00455 AMA1 = 1.251
00456 GAMA1 = 0.599
00457 AMK = 0.493667
00458 AMKZ = 0.49772
00459 AMKST = 0.8921
00460 GAMKST = 0.0513
00461 #elif defined (CLEO)
00462 AMPIZ = 0.134964
00463 AMPI = 0.139568
00464 AMRO = 0.773
00465 GAMRO = 0.145
00466
00467 AMA1 = 1.251
00468 GAMA1 = 0.599
00469 AMK = 0.493667
00470 AMKZ = 0.49772
00471 AMKST = 0.8921
00472 GAMKST = 0.0513
00473
00474
00475
00476
00477
00478
00479
00480
00481
00482
00483
00484
00485 AMA1 = 1.275
00486 GAMA1 = 0.615
00487
00488
00489
00490
00491
00492 #elif defined (ALEPH)
00493 AMPIZ = 0.134964
00494 AMPI = 0.139568
00495 AMRO = 0.7714
00496 GAMRO = 0.153
00497
00498
00499 AMA1 = 1.251
00500 GAMA1 = 0.599
00501 print *,'INIMAS a1 mass= ',ama1,gama1
00502 AMK = 0.493667
00503 AMKZ = 0.49772
00504 AMKST = 0.8921
00505 GAMKST = 0.0513
00506 #else
00507 #endif
00508
00509 WRITE(iout,bxope)
00510 WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INIMAS: '
00511 WRITE(iout,bxtxt) ' Adopted to read from KK '
00512 WRITE(iout,bxINIT) amtau, 'AMTAU tau-mass ','****','***'
00513 WRITE(iout,bxINIT) amel , 'AMEL electron-mass ','****','***'
00514 WRITE(iout,bxINIT) ammu , 'AMMU muon-mass ','****','***'
00515 WRITE(iout,bxclo)
00516
00517 END
00518 SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
00519 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
00520 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00521 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00522 * ,AMK,AMKZ,AMKST,GAMKST
00523
00524 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00525 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00526 * ,AMK,AMKZ,AMKST,GAMKST
00527
00528 AMROP=1.1
00529 GAMROP=0.36
00530 AMOM=.782
00531 GAMOM=0.0084
00532
00533 IF(MNUM.EQ.0) THEN
00534 PROB1=0.5
00535 PROB2=0.5
00536 AMRX =AMA1
00537 GAMRX=GAMA1
00538 AMRA =AMRO
00539 GAMRA=GAMRO
00540 AMRB =AMRO
00541 GAMRB=GAMRO
00542 ELSEIF(MNUM.EQ.1) THEN
00543 PROB1=0.5
00544 PROB2=0.5
00545 AMRX =1.57
00546 GAMRX=0.9
00547 AMRB =AMKST
00548 GAMRB=GAMKST
00549 AMRA =AMRO
00550 GAMRA=GAMRO
00551 ELSEIF(MNUM.EQ.2) THEN
00552 PROB1=0.5
00553 PROB2=0.5
00554 AMRX =1.57
00555 GAMRX=0.9
00556 AMRB =AMKST
00557 GAMRB=GAMKST
00558 AMRA =AMRO
00559 GAMRA=GAMRO
00560 ELSEIF(MNUM.EQ.3) THEN
00561 PROB1=0.5
00562 PROB2=0.5
00563 AMRX =1.27
00564 GAMRX=0.3
00565 AMRA =AMKST
00566 GAMRA=GAMKST
00567 AMRB =AMKST
00568 GAMRB=GAMKST
00569 ELSEIF(MNUM.EQ.4) THEN
00570 PROB1=0.5
00571 PROB2=0.5
00572 AMRX =1.27
00573 GAMRX=0.3
00574 AMRA =AMKST
00575 GAMRA=GAMKST
00576 AMRB =AMKST
00577 GAMRB=GAMKST
00578 ELSEIF(MNUM.EQ.5) THEN
00579 PROB1=0.5
00580 PROB2=0.5
00581 AMRX =1.27
00582 GAMRX=0.3
00583 AMRA =AMKST
00584 GAMRA=GAMKST
00585 AMRB =AMRO
00586 GAMRB=GAMRO
00587 ELSEIF(MNUM.EQ.6) THEN
00588 PROB1=0.4
00589 PROB2=0.4
00590 AMRX =1.27
00591 GAMRX=0.3
00592 AMRA =AMRO
00593 GAMRA=GAMRO
00594 AMRB =AMKST
00595 GAMRB=GAMKST
00596 ELSEIF(MNUM.EQ.7) THEN
00597 PROB1=0.0
00598 PROB2=1.0
00599 AMRX =1.27
00600 GAMRX=0.9
00601 AMRA =AMRO
00602 GAMRA=GAMRO
00603 AMRB =AMRO
00604 GAMRB=GAMRO
00605 ELSEIF(MNUM.EQ.8) THEN
00606 PROB1=0.0
00607 PROB2=1.0
00608 AMRX =AMROP
00609 GAMRX=GAMROP
00610 AMRB =AMOM
00611 GAMRB=GAMOM
00612 AMRA =AMRO
00613 GAMRA=GAMRO
00614 ELSEIF(MNUM.EQ.101) THEN
00615 PROB1=.35
00616 PROB2=.35
00617 AMRX =1.2
00618 GAMRX=.46
00619 AMRB =AMOM
00620 GAMRB=GAMOM
00621 AMRA =AMOM
00622 GAMRA=GAMOM
00623 ELSEIF(MNUM.EQ.102) THEN
00624 PROB1=0.0
00625 PROB2=0.0
00626 AMRX =1.4
00627 GAMRX=.6
00628 AMRB =AMOM
00629 GAMRB=GAMOM
00630 AMRA =AMOM
00631 GAMRA=GAMOM
00632 ELSE
00633 PROB1=0.0
00634 PROB2=0.0
00635 AMRX =AMA1
00636 GAMRX=GAMA1
00637 AMRA =AMRO
00638 GAMRA=GAMRO
00639 AMRB =AMRO
00640 GAMRB=GAMRO
00641 ENDIF
00642
00643 IF (RR.LE.PROB1) THEN
00644 ICHAN=1
00645 ELSEIF(RR.LE.(PROB1+PROB2)) THEN
00646 ICHAN=2
00647 AX =AMRA
00648 GX =GAMRA
00649 AMRA =AMRB
00650 GAMRA=GAMRB
00651 AMRB =AX
00652 GAMRB=GX
00653 PX =PROB1
00654 PROB1=PROB2
00655 PROB2=PX
00656 ELSE
00657 ICHAN=3
00658 ENDIF
00659
00660 PROB3=1.0-PROB1-PROB2
00661 END
00662 FUNCTION DCDMAS(IDENT)
00663 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00664 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00665 * ,AMK,AMKZ,AMKST,GAMKST
00666
00667 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00668 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00669 * ,AMK,AMKZ,AMKST,GAMKST
00670 IF (IDENT.EQ. 1) THEN
00671 APKMAS=AMPI
00672 ELSEIF (IDENT.EQ.-1) THEN
00673 APKMAS=AMPI
00674 ELSEIF (IDENT.EQ. 2) THEN
00675 APKMAS=AMPIZ
00676 ELSEIF (IDENT.EQ.-2) THEN
00677 APKMAS=AMPIZ
00678 ELSEIF (IDENT.EQ. 3) THEN
00679 APKMAS=AMK
00680 ELSEIF (IDENT.EQ.-3) THEN
00681 APKMAS=AMK
00682 ELSEIF (IDENT.EQ. 4) THEN
00683 APKMAS=AMKZ
00684 ELSEIF (IDENT.EQ.-4) THEN
00685 APKMAS=AMKZ
00686 ELSEIF (IDENT.EQ. 8) THEN
00687 APKMAS=0.0001
00688 ELSEIF (IDENT.EQ.-8) THEN
00689 APKMAS=0.0001
00690 ELSEIF (IDENT.EQ. 9) THEN
00691 APKMAS=0.5488
00692 ELSEIF (IDENT.EQ.-9) THEN
00693 APKMAS=0.5488
00694 ELSE
00695 PRINT *, 'STOP IN APKMAS, WRONG IDENT=',IDENT
00696 STOP
00697 ENDIF
00698 DCDMAS=APKMAS
00699 END
00700 FUNCTION LUNPIK(ID,ISGN)
00701 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00702 REAL*4 BRA1,BRK0,BRK0B,BRKS
00703 REAL*4 XIO(1)
00704 IDENT=ID*ISGN
00705 #if defined (ALEPH)
00706 IF (IDENT.EQ. 1) THEN
00707 IPKDEF= 211
00708 ELSEIF (IDENT.EQ.-1) THEN
00709 IPKDEF=-211
00710 ELSEIF (IDENT.EQ. 2) THEN
00711 IPKDEF= 111
00712 ELSEIF (IDENT.EQ.-2) THEN
00713 IPKDEF= 111
00714 ELSEIF (IDENT.EQ. 3) THEN
00715 IPKDEF= 321
00716 ELSEIF (IDENT.EQ.-3) THEN
00717 IPKDEF=-321
00718 #else
00719 IF (IDENT.EQ. 1) THEN
00720 IPKDEF=-211
00721 ELSEIF (IDENT.EQ.-1) THEN
00722 IPKDEF= 211
00723 ELSEIF (IDENT.EQ. 2) THEN
00724 IPKDEF=111
00725 ELSEIF (IDENT.EQ.-2) THEN
00726 IPKDEF=111
00727 ELSEIF (IDENT.EQ. 3) THEN
00728 IPKDEF=-321
00729 ELSEIF (IDENT.EQ.-3) THEN
00730 IPKDEF= 321
00731 #endif
00732 ELSEIF (IDENT.EQ. 4) THEN
00733
00734
00735 CALL RANMAR(XIO,1)
00736 IF (XIO(1).GT.BRK0) THEN
00737 IPKDEF= 130
00738 ELSE
00739 IPKDEF= 310
00740 ENDIF
00741 ELSEIF (IDENT.EQ.-4) THEN
00742
00743
00744 CALL RANMAR(XIO,1)
00745 IF (XIO(1).GT.BRK0B) THEN
00746 IPKDEF= 130
00747 ELSE
00748 IPKDEF= 310
00749 ENDIF
00750 ELSEIF (IDENT.EQ. 8) THEN
00751 IPKDEF= 22
00752 ELSEIF (IDENT.EQ.-8) THEN
00753 IPKDEF= 22
00754 ELSEIF (IDENT.EQ. 9) THEN
00755 IPKDEF= 221
00756 ELSEIF (IDENT.EQ.-9) THEN
00757 IPKDEF= 221
00758 ELSE
00759 PRINT *, 'STOP IN IPKDEF, WRONG IDENT=',IDENT
00760 STOP
00761 ENDIF
00762 LUNPIK=IPKDEF
00763 END
00764
00765
00766 #if defined (CLEO)
00767
00768 SUBROUTINE TAURDF(KTO)
00769
00770
00771
00772 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00773 REAL*4 BRA1,BRK0,BRK0B,BRKS
00774 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00775 IF (KTO.EQ.1) THEN
00776
00777
00778 BRA1 = PKORB(4,1)
00779 BRKS = PKORB(4,3)
00780 BRK0 = PKORB(4,5)
00781 BRK0B = PKORB(4,6)
00782 ELSE
00783
00784
00785 BRA1 = PKORB(4,2)
00786 BRKS = PKORB(4,4)
00787 BRK0 = PKORB(4,5)
00788 BRK0B = PKORB(4,6)
00789 ENDIF
00790
00791 END
00792 #else
00793
00794 SUBROUTINE TAURDF(KTO)
00795
00796
00797
00798 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00799 REAL*4 BRA1,BRK0,BRK0B,BRKS
00800 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00801 IF (KTO.EQ.1) THEN
00802
00803
00804 NCHAN = 19
00805 DO 1 I = 1,30
00806 IF (I.LE.NCHAN) THEN
00807 JLIST(I) = I
00808 IF(I.EQ. 1) GAMPRT(I) = .0000
00809 IF(I.EQ. 2) GAMPRT(I) = .0000
00810 IF(I.EQ. 3) GAMPRT(I) = .0000
00811 IF(I.EQ. 4) GAMPRT(I) = .0000
00812 IF(I.EQ. 5) GAMPRT(I) = .0000
00813 IF(I.EQ. 6) GAMPRT(I) = .0000
00814 IF(I.EQ. 7) GAMPRT(I) = .0000
00815 IF(I.EQ. 8) GAMPRT(I) = 1.0000
00816 IF(I.EQ. 9) GAMPRT(I) = 1.0000
00817 IF(I.EQ.10) GAMPRT(I) = 1.0000
00818 IF(I.EQ.11) GAMPRT(I) = 1.0000
00819 IF(I.EQ.12) GAMPRT(I) = 1.0000
00820 IF(I.EQ.13) GAMPRT(I) = 1.0000
00821 IF(I.EQ.14) GAMPRT(I) = 1.0000
00822 IF(I.EQ.15) GAMPRT(I) = 1.0000
00823 IF(I.EQ.16) GAMPRT(I) = 1.0000
00824 IF(I.EQ.17) GAMPRT(I) = 1.0000
00825 IF(I.EQ.18) GAMPRT(I) = 1.0000
00826 IF(I.EQ.19) GAMPRT(I) = 1.0000
00827 ELSE
00828 JLIST(I) = 0
00829 GAMPRT(I) = 0.
00830 ENDIF
00831 1 CONTINUE
00832
00833
00834
00835
00836
00837
00838
00839
00840 BRA1=0.5
00841 BRK0=0.5
00842 BRK0B=0.5
00843 BRKS=0.6667
00844 ELSE
00845
00846
00847 NCHAN = 19
00848 DO 2 I = 1,30
00849 IF (I.LE.NCHAN) THEN
00850 JLIST(I) = I
00851 IF(I.EQ. 1) GAMPRT(I) = .0000
00852 IF(I.EQ. 2) GAMPRT(I) = .0000
00853 IF(I.EQ. 3) GAMPRT(I) = .0000
00854 IF(I.EQ. 4) GAMPRT(I) = .0000
00855 IF(I.EQ. 5) GAMPRT(I) = .0000
00856 IF(I.EQ. 6) GAMPRT(I) = .0000
00857 IF(I.EQ. 7) GAMPRT(I) = .0000
00858 IF(I.EQ. 8) GAMPRT(I) = 1.0000
00859 IF(I.EQ. 9) GAMPRT(I) = 1.0000
00860 IF(I.EQ.10) GAMPRT(I) = 1.0000
00861 IF(I.EQ.11) GAMPRT(I) = 1.0000
00862 IF(I.EQ.12) GAMPRT(I) = 1.0000
00863 IF(I.EQ.13) GAMPRT(I) = 1.0000
00864 IF(I.EQ.14) GAMPRT(I) = 1.0000
00865 IF(I.EQ.15) GAMPRT(I) = 1.0000
00866 IF(I.EQ.16) GAMPRT(I) = 1.0000
00867 IF(I.EQ.17) GAMPRT(I) = 1.0000
00868 IF(I.EQ.18) GAMPRT(I) = 1.0000
00869 IF(I.EQ.19) GAMPRT(I) = 1.0000
00870 ELSE
00871 JLIST(I) = 0
00872 GAMPRT(I) = 0.
00873 ENDIF
00874 2 CONTINUE
00875
00876
00877
00878
00879
00880
00881
00882
00883 BRA1=0.5
00884 BRK0=0.5
00885 BRK0B=0.5
00886 BRKS=0.6667
00887 ENDIF
00888
00889 END
00890 #endif