source: trunk/MagicSoft/Simulation/Corsika/Mmcs/bhabha.f@ 18679

Last change on this file since 18679 was 286, checked in by harald, 25 years ago
This is the start point for further developments of the Magic Monte Carlo Simulation written by Jose Carlos Gonzales. Now it is under control of one CVS repository for the whole collaboration. Everyone should use this CVS repository for further developments.
File size: 3.7 KB
Line 
1 SUBROUTINE BHABHA
2C VERSION 4.00 -- 26 JAN 1986/1900
3C******************************************************************
4C DISCRETE BHABHA SCATTERING (A CALL TO THIS ROUTINE) HAS BEEN
5C ARBITRARILY DEFINED AND CALCULATED TO MEAN BHABHA SCATTERINGS
6C WHICH IMPART TO THE SECONDARY ELECTRON SUFFICIENT ENERGY THAT
7C IT BE TRANSPORTED DISCRETELY, I.E. E=AE OR T=TE. IT IS NOT
8C GUARANTEED THAT THE FINAL POSITRON WILL HAVE THIS MUCH ENERGY
9C HOWEVER. THE EXACT BHABHA DIFFERENTIAL CROSS SECTION IS USED.
10C******************************************************************
11 DOUBLE PRECISION PEIP,PEKSE2,PESE1,PESE2
12 DOUBLE PRECISION PEKIN,PEKINI,H1,DCOSTH
13*KEEP,RANDPA.
14 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
15 DOUBLE PRECISION FAC,U1,U2
16 REAL RD(3000)
17 INTEGER ISEED(103,10),NSEQ
18 LOGICAL KNOR
19*KEEP,RUNPAR.
20 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
21 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
22 * MONIOU,MDEBUG,NUCNUC,
23 * CETAPE,
24 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
25 * N1STTR,MDBASE,
26 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
27 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
28 * ,GHEISH,GHESIG
29 COMMON /RUNPAC/ DSN,HOST,USER
30 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
31 REAL STEPFC
32 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
33 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
34 * N1STTR,MDBASE
35 INTEGER CETAPE
36 CHARACTER*79 DSN
37 CHARACTER*20 HOST,USER
38
39 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
40 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
41 * ,GHEISH,GHESIG
42*KEEP,STACKE.
43 COMMON/STACKE/ E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
44 DOUBLE PRECISION E(60),TIME(60)
45 REAL X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
46 INTEGER IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
47*KEND.
48 COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
49 COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
50 DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
51 COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
52 COMMON/ACLOCK/NCLOCK,JCLOCK
53C_____IF (NCLOCK.GT.JCLOCK) THEN
54C______WRITE(MDEBUG,* )' BHABHA:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
55C______CALL AUSGB2
56C_____END IF
57 PEIP=E(NP)
58 EIP=PEIP
59 PEKIN=PEIP-PRM
60 EKIN=PEKIN
61 PEKINI=1./PEKIN
62 EKINI=PEKINI
63 T0=EKIN*RMI
64 E0=T0+1.
65 YY=1./(T0+2.)
66 E02=E0*E0
67 BETAI2=E02/(E02-1.)
68 EP0=TE*EKINI
69 EP0C=1.-EP0
70 Y2=YY*YY
71 YP=1.-2.*YY
72 YP2=YP*YP
73 B4=YP2*YP
74 B3=B4+YP2
75 B2=YP*(3.+Y2)
76 B1=2.-Y2
77341 CONTINUE
78 CALL RMMAR(RD,2,2)
79 RNNO03=RD(1)
80 RNNO04=RD(2)
81 BR=EP0/(1.-EP0C*RNNO03)
82 REJF2=EP0C*(BETAI2-BR*(B1-BR*(B2-BR*(B3-BR*B4))))
83 IF((RNNO04.LE.REJF2))GO TO342
84 GO TO 341
85342 CONTINUE
86 IF (BR.LT.0.5) THEN
87 IQ(NP+1)=3
88 ELSE
89 IQ(NP)=3
90 IQ(NP+1)=2
91 BR=1.-BR
92 END IF
93 BR=MAX(BR,0.0)
94 PEKSE2=BR*EKIN
95 PESE1=PEIP-PEKSE2
96 PESE2=PEKSE2+PRM
97 E(NP)=PESE1
98 E(NP+1)=PESE2
99 H1=(PEIP+PRM)*PEKINI
100 DCOSTH=MIN(H1*(PESE1-PRM)/(PESE1+PRM),1.D0)
101 SINTHE=SQRT(1.D0-DCOSTH)
102 COSTHE=SQRT(DCOSTH)
103 CALL UPHI(2,1)
104 NP=NP+1
105 DCOSTH=MIN(H1*(PESE2-PRM)/(PESE2+PRM),1.D0)
106 SINTHE=-SQRT(1.D0-DCOSTH)
107 COSTHE=SQRT(DCOSTH)
108 CALL UPHI(3,2)
109 RETURN
110 END
Note: See TracBrowser for help on using the repository browser.