source: trunk/MagicSoft/Simulation/Corsika/Mmcs/moller.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.8 KB
Line 
1 SUBROUTINE MOLLER
2C VERSION 4.00 -- 26 JAN 1986/1900
3C******************************************************************
4C DISCRETE MOLLER SCATTERING (A CALL TO THIS ROUTINE) HAS BEEN
5C ARBITRARILY DEFINED AND CALCULATED TO MEAN MOLLER SCATTERINGS
6C WHICH IMPART TO THE SECONDARY ELECTRON SUFFICIENT ENERGY THAT
7C IT BE TRANSPORTED DISCRETELY. THE THRESHOLD TO TRANSPORT AN
8C ELECTRON DISCRETELY IS A TOTAL ENERGY OF AE OR A KINETIC ENERGY
9C OF TE=AE-RM. SINCE THE KINETIC ENERGY TRANSFER IS ALWAYS, BY
10C DEFINITION, LESS THAN HALF OF THE INCIDENT KINETIC ENERGY, THIS
11C IMPLIES THAT THE INCIDENT ENERGY, EIE, MUST BE LARGER THAN
12C THMOLL=TE*2+RM. THE REST OF THE COLLISION CONTRIBUTION IS
13C SUBTRACTED CONTINUOUSLY FROM THE ELECTRON AS IONIZATION
14C LOSS DURING TRANSPORT.
15C******************************************************************
16 DOUBLE PRECISION PEIE,PEKSE2,PESE1,PESE2
17 DOUBLE PRECISION PEKIN,H1,DCOSTH,PEKINI
18*KEEP,RANDPA.
19 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
20 DOUBLE PRECISION FAC,U1,U2
21 REAL RD(3000)
22 INTEGER ISEED(103,10),NSEQ
23 LOGICAL KNOR
24*KEEP,RUNPAR.
25 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
26 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
27 * MONIOU,MDEBUG,NUCNUC,
28 * CETAPE,
29 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
30 * N1STTR,MDBASE,
31 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
32 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
33 * ,GHEISH,GHESIG
34 COMMON /RUNPAC/ DSN,HOST,USER
35 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
36 REAL STEPFC
37 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
38 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
39 * N1STTR,MDBASE
40 INTEGER CETAPE
41 CHARACTER*79 DSN
42 CHARACTER*20 HOST,USER
43
44 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
45 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
46 * ,GHEISH,GHESIG
47*KEEP,STACKE.
48 COMMON/STACKE/ E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
49 DOUBLE PRECISION E(60),TIME(60)
50 REAL X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
51 INTEGER IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
52*KEND.
53 COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
54 COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
55 DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
56 COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
57 COMMON/ACLOCK/NCLOCK,JCLOCK
58C_____IF (NCLOCK.GT.JCLOCK) THEN
59C______WRITE(MDEBUG,* )' MOLLER:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
60C______CALL AUSGB2
61C_____END IF
62 PEIE=E(NP)
63 EIE=PEIE
64 PEKIN=PEIE-PRM
65 EKIN=PEKIN
66 PEKINI=1./PEKIN
67 EKINI=PEKINI
68 T0=EKIN*RMI
69 E0=T0+1.0
70 EXTRAE = EIE - THMOLL
71 E02=E0*E0
72 BETAI2=E02/(E02-1.0)
73 EP0=TE*EKINI
74 G1=(1.-2.*EP0)*BETAI2
75 G2=T0*T0*(1./E02)
76 G3=(2.*T0+1.)*(1./E02)
77931 CONTINUE
78 CALL RMMAR(RD,2,2)
79 RNNO27=RD(1)
80 RNNO28=RD(2)
81 BR = TE/(EKIN-EXTRAE*RNNO27)
82 R=BR/(1.-BR)
83 REJF4=G1*(1.+G2*BR*BR+R*(R-G3))
84 IF((RNNO28.LE.REJF4))GO TO932
85 GO TO 931
86932 CONTINUE
87 PEKSE2=BR*EKIN
88 PESE1=PEIE-PEKSE2
89 PESE2=PEKSE2+PRM
90 E(NP)=PESE1
91 E(NP+1)=PESE2
92 H1=(PEIE+PRM)*PEKINI
93 DCOSTH=MIN(H1*(PESE1-PRM)/(PESE1+PRM),1.D0)
94 SINTHE=SQRT(1.D0-DCOSTH)
95 COSTHE=SQRT(DCOSTH)
96 CALL UPHI(2,1)
97 NP=NP+1
98 IQ(NP)=3
99 DCOSTH=MIN(H1*(PESE2-PRM)/(PESE2+PRM),1.D0)
100 SINTHE=-SQRT(1.D0-DCOSTH)
101 COSTHE=SQRT(DCOSTH)
102 CALL UPHI(3,2)
103 RETURN
104 END
Note: See TracBrowser for help on using the repository browser.