source: trunk/MagicSoft/Simulation/Corsika/Mmcs/difrac.f

Last change on this file 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: 8.3 KB
Line 
1 SUBROUTINE DIFRAC( NRETFL )
2
3C-----------------------------------------------------------------------
4C (SINGLE) DIF(F)RAC(TION)
5C
6C SETS PARAMETERS FOR HDPM IN CASE OF SINGLE DIFFRACTION
7C THIS SUBROUTINE IS CALLED FROM HDPM
8C ARGUMENT:
9C NRETFL = 0 CORRECT ENDING OF SUBROUTINE
10C = 1 INCORRECT ENDING OF SUBROUTINE
11C-----------------------------------------------------------------------
12
13 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
14*KEEP,DPMFLG.
15 COMMON /DPMFLG/ NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
16 INTEGER NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
17*KEEP,INTER.
18 COMMON /INTER/ AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
19 * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
20 * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
21 * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
22 * IDIF,ITAR
23 DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
24 * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
25 * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
26 * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
27 INTEGER IDIF,ITAR
28*KEEP,LEPAR.
29 COMMON /LEPAR/ LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
30 INTEGER LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
31*KEEP,PAM.
32 COMMON /PAM/ PAMA,SIGNUM
33 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
34*KEEP,PARPAR.
35 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
36 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
37 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
38 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
39 INTEGER ITYPE,LEVL
40*KEEP,PARPAE.
41 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
42 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
43 * (CURPAR(4), PHI ), (CURPAR(5), H ),
44 * (CURPAR(6), T ), (CURPAR(7), X ),
45 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
46 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
47 * (CURPAR(12),ECM )
48*KEEP,RANDPA.
49 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
50 DOUBLE PRECISION FAC,U1,U2
51 REAL RD(3000)
52 INTEGER ISEED(103,10),NSEQ
53 LOGICAL KNOR
54*KEEP,REST.
55 COMMON /REST/ CONTNE,TAR,LT
56 DOUBLE PRECISION CONTNE(3),TAR
57 INTEGER LT
58*KEEP,RUNPAR.
59 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
60 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
61 * MONIOU,MDEBUG,NUCNUC,
62 * CETAPE,
63 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
64 * N1STTR,MDBASE,
65 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
66 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
67 * ,GHEISH,GHESIG
68 COMMON /RUNPAC/ DSN,HOST,USER
69 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
70 REAL STEPFC
71 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
72 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
73 * N1STTR,MDBASE
74 INTEGER CETAPE
75 CHARACTER*79 DSN
76 CHARACTER*20 HOST,USER
77
78 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
79 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
80 * ,GHEISH,GHESIG
81*KEND.
82
83C-----------------------------------------------------------------------
84
85 IF ( DEBUG ) WRITE(MDEBUG,*) 'DIFRAC:'
86
87C DECIDE FIRST, WHETHER PROJECTILE OR TARGET DIFFRACTION
88 CALL RMMAR( RD,1,1 )
89 IF ( RD(1) .LE. 0.5 ) THEN
90C PROJECTILE DIFFRACTON, TARGET DIFFRACTION FLAG IS NOT SET
91 NFTARD = 0
92C MASS OF INCOMING PARTICLE AND PI(0) MASS
93C PI(0) IS MINIMAL OUTCOME OF SECONDARIES IN DIFRAC
94 XM0 = ( PAMA(LEPAR1) + PAMA(7) )**2
95 ELSE
96C TARGET DIFFRACTON, SET TARGET DIFFRACTION FLAG
97 NFTARD = 1
98C MASS OF NUCLEON AND PI(0) MASS
99C PI(0) IS MINIMAL OUTCOME OF SECONDARIES IN DIFRAC
100 XM0 = ( PAMA(LEPAR2) + PAMA(7) )**2
101 ENDIF
102C MAXIMAL DIFFRACTIVE MASS, FACTOR 0.15 GIVEN BY COHERENCE CONDITION
103 XMX = 0.15D0 * S
104
105C THROW MAXIMAL 200 TIMES TO GET A GOOD DIFFRACTIVE MASS
106 NCDIFL = 0
107 7 CONTINUE
108C GET DIFFRACTIVE MASS
109 CALL RMMAR( RD,2,1 )
110C GET S (=ECM**2) (WHY THIS WAY OF THROWING ???)
111 SDIF = (XMX/XM0)**RD(1) * XM0
112
113 IF ( SDIF .LE. XM0 ) THEN
114 IF ( NCDIFL .LE. 200 ) THEN
115 NCDIFL = NCDIFL + 1
116 GOTO 7
117 ELSE
118C SET RETURN FLAG TO ERROR
119 NRETFL = 1
120 RETURN
121 ENDIF
122 ENDIF
123
124C DISTRIBUTION OF DIFFRACTIVE MASS FLATTENS OFF FOR DIFFRACTIVE
125C MASS SQUARED .LE. 2 GEV
126 IF ( SDIF .LE. 2.D0 ) THEN
127C----- SO GEHT DAS NICHT!! 16.12.91 D.H.
128 SDIF = RD(2) * (2.D0 - XM0) + XM0
129 ENDIF
130C SQRT(S) IS ECM
131 ECMDIF = SQRT(SDIF)
132C LOG(S), LOG(S)**2
133 DLOG = LOG(SDIF)
134 DLOGSQ = DLOG**2
135 IF ( DEBUG ) WRITE(MDEBUG,*) 'DIFRAC: SDIF,ECMDIF,NFTARD=',
136 * SNGL(SDIF),SNGL(ECMDIF),NFTARD
137
138C RAPIDITY IN CMS OF DIFFRACTIVE SYSTEM
139C TO CALCULATE DMLOG, SUBTRACT SUM OF MASS SQUARES FROM SDIF
140C PI(0) MASS SQUARED IS 0.0182.
141 IF ( NFTARD .EQ. 0 ) THEN
142 YY0 = LOG(ECMDPM/ECMDIF)
143 DMLOG = LOG(SDIF - 0.0182D0 - PAMA(LEPAR1)**2)
144 ELSE
145 YY0 = -LOG(ECMDPM/ECMDIF)
146 DMLOG = LOG(SDIF - 0.0182D0 - PAMA(LEPAR2)**2)
147 ENDIF
148 IF ( DEBUG ) WRITE(MDEBUG,*) 'DIFRAC: YY0,DMLOG=',
149 * SNGL(YY0),SNGL(DMLOG)
150C CENTRAL RAPIDITY DENSITY IN CMS OF DIFFRACTIVE SYSTEM
151C PARAMETRISATION SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.7
152C WE USE ONLY THE LOW-ENERGY PART OF THE PARAMETRISATION, AS SDIF DOES
153C NOT REACH THE HIGHER VALUES
154 DC0 = 0.82D0 * (SDIF**0.107D0)
155
156C THERE ARE 3 ENERGY DEPENDENT FORMULAS FOR AVERAGE CHARGED
157C MULTIPLICITY ( AVCH1 );
158C PARAMETRISATIONS SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.8
159 IF ( ECMDIF .LE. 187.5D0 ) THEN
160C CHARGED MULTIPLICITY (M**2 IN PLACE OF S)
161 AVCH1 = 0.57D0 + 0.584D0*DLOG + 0.127D0*DLOGSQ
162 ELSEIF ( ECMDIF .LE. 945.5D0 ) THEN
163 AVCH1 = -6.55D0 + 6.89D0 * SDIF**0.131D0
164 ELSE
165 AVCH1 = 3.4D0 * SDIF**0.17D0
166 ENDIF
167C PARAMETRISATION IS BASED ON COLLIDER DATA WHERE PROTON AND ANTIPROTON
168C ARE INCLUDED. LOWER LIMIT FOR AVERAGE CHARGED MULTIPLICITY IS 1.
169 AVCH1 = MAX( 1.D0, AVCH1 )
170
171C CENTER OF GAUSSIAN 1ST+2ND STRING OF FRAGMENTATION SYSTEM
172 POSC2 = 0.146D0 * DMLOG + 0.072D0
173C WIDTH OF GAUSSIAN 1ST+2ND STRING OF FRAGMENTATION SYSTEM
174 WIDC2 = 0.120D0 * DMLOG + 0.180D0
175C INTERACTION FACTOR GNU FOR INTERACTION WITH NUCLEUS;
176 IF ( NFLAIN .EQ. 0 ) THEN
177 GNU = 1.D0
178 AVCH3 = 0.D0
179 POSC3 = 0.D0
180 WIDC3 = 1.D0
181 ELSE
182C NEW PARAMETRIZATION OF J.N.CAPDEVIELLE (MARCH 93)
183 GNU = (0.4826D0 + 3.522D-2 * DLOG) * TAR**0.31D0
184C CENTER OF GAUSSIAN FOR 3RD STRING (FROM TARGET)
185 POSC3 = +3.D0 - 2.575D0 * EXP( -0.081756452D0 * GNU )
186C WIDTH OF GAUSSIAN FOR 3RD STRING (FROM TARGET)
187 WIDC3 = 1.2338466D0 + 0.078969916D0 * LOG(GNU)
188 IF ( ECMDIF .LE. 137.D0 ) THEN
189 AVCH3 = 0.57D0 * AVCH1 * (GNU-1.D0)
190 ELSE
191 AVCH3 = 0.5D0 * AVCH1 * (GNU-1.D0)
192 ENDIF
193 ENDIF
194 IF ( DEBUG ) WRITE(MDEBUG,100)
195 * SNGL(POSC2),SNGL(WIDC2),SNGL(POSC3),SNGL(WIDC3)
196 100 FORMAT(' DIFRAC: POSC2,WIDC2,POSC3,WIDC3=',4F12.7)
197C AVERAGE CHARGED, INCLUDING THOSE FROM TARGET
198 AVCH = AVCH1 + AVCH3
199C THE FOLOWING PROCEDURE IS TO PRODUCE PHOTONS FROM UNKNOWN NEUTRAL
200C DECAYS FOLLOWING CORRELATION WITH CHARGED PARTICLES BASED ON
201C PHOTON EXCESS AT COLLIDER EXPERIMENTS. SEUGP IS <N_PHOTON>
202C PROBLEM OF THE RISE OF THE UNKNOWN ETA PRODUCTION CROSS SECTION
203C IS SOLVED WITH PARAMETRISATION OF UA5 (Z. PHYS. C43 (1989) 75)
204 IF ( ECMDIF .LE. 103.D0 ) THEN
205 SEUGP = -1.27D0 + 0.52D0 * DLOG + 0.148D0 * DLOGSQ
206 ELSE
207C AT HIGH DIFFRACTIVE MASS USE PARAMETRISATION OF THOUW ????
208 SEUGP = -18.7D0 + 11.55D0 * SDIF**0.1195D0
209 ENDIF
210 SEUGP = MAX( 0.5D0, SEUGP )
211 IF ( DEBUG ) WRITE(MDEBUG,110)
212 * SNGL(DC0),SNGL(AVCH1),SNGL(AVCH3),SNGL(AVCH),SNGL(SEUGP)
213 110 FORMAT(' DIFRAC: DC0,AVCH1,AVCH3,AVCH,SEUGP=',5F12.6)
214
215C SET RETURN FLAG TO OK
216 NRETFL = 0
217 RETURN
218 END
Note: See TracBrowser for help on using the repository browser.