source: trunk/MagicSoft/Simulation/Corsika/Mmcs/brems.f@ 6203

Last change on this file since 6203 was 286, checked in by harald, 26 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: 4.2 KB
Line 
1 SUBROUTINE BREMS
2C VERSION 4.00 -- 26 JAN 1986/1900
3C******************************************************************
4C FOR ELECTRON ENERGY GREATER THAN 5.0 MEV, THE BETHE-HEITLER
5C CROSS SECTION IS EMPLOYED.
6C******************************************************************
7 DOUBLE PRECISION PEIE,PESG,PESE
8 COMMON/BREMPR/DL1(6),DL2(6),DL3(6),DL4(6),DL5(6),DL6(6),DELCM, ALP
9 *HI(2),BPAR(2),DELPOS(2),PWR2I(50)
10*KEEP,RANDPA.
11 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
12 DOUBLE PRECISION FAC,U1,U2
13 REAL RD(3000)
14 INTEGER ISEED(103,10),NSEQ
15 LOGICAL KNOR
16*KEEP,RUNPAR.
17 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
18 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
19 * MONIOU,MDEBUG,NUCNUC,
20 * CETAPE,
21 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
22 * N1STTR,MDBASE,
23 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
24 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
25 * ,GHEISH,GHESIG
26 COMMON /RUNPAC/ DSN,HOST,USER
27 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
28 REAL STEPFC
29 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
30 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
31 * N1STTR,MDBASE
32 INTEGER CETAPE
33 CHARACTER*79 DSN
34 CHARACTER*20 HOST,USER
35
36 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
37 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
38 * ,GHEISH,GHESIG
39*KEEP,STACKE.
40 COMMON/STACKE/ E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
41 DOUBLE PRECISION E(60),TIME(60)
42 REAL X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
43 INTEGER IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
44*KEND.
45 COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
46 COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
47 DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
48 COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
49 COMMON/ACLOCK/NCLOCK,JCLOCK
50 DATA AI2LN2/0.7213475/
51C_____IF (NCLOCK.GT.JCLOCK) THEN
52C______WRITE(MDEBUG,* )' BREMS: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
53C______CALL AUSGB2
54C_____END IF
55 PEIE=E(NP)
56 EIE=PEIE
57 NP=NP+1
58 IF (EIE.LT.50.0) THEN
59 LVX=1
60 LVL0=0
61 ELSE
62 LVX=2
63 LVL0=3
64 END IF
65 ABREMS=REAL(IFIX(1.44269*ALOG(EIE*API)))
66351 CONTINUE
67 CALL RMMAR(RNNO06,1,2)
68 IF (0.5.LT.((ABREMS*ALPHI(LVX)+0.5)*RNNO06)) THEN
69 CALL RMMAR(RD,2,2)
70 RNNO07=RD(1)
71 RNNO08=RD(2)
72 IDISTR=ABREMS*RNNO07
73 P=PWR2I(IDISTR+1)
74 LVL=LVL0+1
75 IF (RNNO08.GE.AI2LN2) THEN
76361 CONTINUE
77 CALL RMMAR(RD,3,2)
78 RNNO09=RD(1)
79 RNNO10=RD(2)
80 RNNO11=RD(3)
81 H=MAX(RNNO10,RNNO11)
82 BR=1.0-0.5*H
83 IF((BR*RNNO09.LE.0.5))GO TO362
84 GO TO 361
85362 CONTINUE
86 ELSE
87 CALL RMMAR(RNNO12,1,2)
88 BR=RNNO12*0.5
89 END IF
90 BR=BR*P
91 ELSE
92 CALL RMMAR(RD,2,2)
93 RNNO13=RD(1)
94 RNNO14=RD(2)
95 BR=MAX(RNNO13,RNNO14)
96 LVL=LVL0+2
97 END IF
98 ESG=EIE*BR
99 IF((ESG.LT.AP))GO TO351
100 PESG=ESG
101 PESE=PEIE-PESG
102 ESE=PESE
103 IF((ESE.LT.RM))GO TO351
104 DEL = BR/ESE
105 IF((DEL.GE.DELPOS(LVX)))GO TO351
106 DELTA = DELCM*DEL
107 IF (DELTA.LT.1.0) THEN
108 REJF=DL1(LVL)+DELTA*(DL2(LVL)+DELTA*DL3(LVL))
109 ELSE
110 REJF=DL4(LVL)+DL5(LVL)*LOG(DELTA+DL6(LVL))
111 END IF
112 CALL RMMAR(RNSCRN,1,2)
113 IF((RNSCRN.LE.REJF))GO TO352
114 GO TO 351
115352 CONTINUE
116 THETA=RM/EIE
117 CALL UPHI(1,3)
118 IF (ESG.LE.ESE) THEN
119 IQ(NP)=1
120 E(NP)=PESG
121 E(NP-1)=PESE
122 ELSE
123 IQ(NP)=IQ(NP-1)
124 IQ(NP-1)=1
125 E(NP)=PESE
126 E(NP-1)=PESG
127 T=U(NP)
128 U(NP)=U(NP-1)
129 U(NP-1)=T
130 T=V(NP)
131 V(NP)=V(NP-1)
132 V(NP-1)=T
133 T=W(NP)
134 W(NP)=W(NP-1)
135 W(NP-1)=T
136 END IF
137 RETURN
138 END
Note: See TracBrowser for help on using the repository browser.