source: trunk/MagicSoft/Simulation/Corsika/Mmcs/leaddf.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: 4.8 KB
Line 
1 SUBROUTINE LEADDF( IFLGLD )
2
3C-----------------------------------------------------------------------
4C LEAD(ING PARTICLE RAPIDITY FOR) D(I)F(FFRACTING SYSTEM)
5C
6C SELECTS THE RAPIDITY OF THE (ANTI)LEADING PARTICLES IN CASE OF
7C DIFFRACTION. THE NON-DIFFRACTING (ANTI)LEADER GETS ITS RAPIDITY
8C FROM THE REMAINDER ENERGY, THE DIFFRACTING (ANTI)LEADER GETS ITS
9C RAPIDITY FROM THE GAUSSIAN (STRING) OF THE DECAYING DIFFRACTIVE MASS.
10C THIS SUBROUTINE IS CALLED FROM HDPM
11C ARGUMENT:
12C IFLGLD = 0 RAPIDITY SELECTION SUCCESSFUL
13C = 1 RAPIDITY SELECTION NOT SUCCESSFULL
14C-----------------------------------------------------------------------
15
16 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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,NEWPAR.
32 COMMON /NEWPAR/ EA,PT2,PX,PY,TMAS,YR,ITYP,
33 * IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
34 * IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
35 DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
36 * YR(3000)
37 INTEGER ITYP(3000),
38 * IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
39 * IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
40*KEEP,RANDPA.
41 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
42 DOUBLE PRECISION FAC,U1,U2
43 REAL RD(3000)
44 INTEGER ISEED(103,10),NSEQ
45 LOGICAL KNOR
46*KEEP,RUNPAR.
47 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
48 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
49 * MONIOU,MDEBUG,NUCNUC,
50 * CETAPE,
51 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
52 * N1STTR,MDBASE,
53 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
54 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
55 * ,GHEISH,GHESIG
56 COMMON /RUNPAC/ DSN,HOST,USER
57 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
58 REAL STEPFC
59 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
60 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
61 * N1STTR,MDBASE
62 INTEGER CETAPE
63 CHARACTER*79 DSN
64 CHARACTER*20 HOST,USER
65
66 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
67 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
68 * ,GHEISH,GHESIG
69*KEND.
70
71C-----------------------------------------------------------------------
72
73 IF ( DEBUG ) WRITE(MDEBUG,*) 'LEADDF: LEPAR1,LEPAR2=',
74 * LEPAR1,LEPAR2
75
76 IF ( YY0 .GT. 0.D0 ) THEN
77C PROJECTILE DIFFRACTION; CALCULATE TARGET RAPIDITY USING TARGET
78C ENERGY ECMTAR AND LONGITUDINAL MOMENTUM PCMTAR THE IN C.M. SYSTEM
79 ECMTAR = (ECMDPM**2 - ECMDIF**2 + TMAS(2)**2) / (2.D0 * ECMDPM)
80 PTLSQ = ECMTAR**2 - TMAS(2)**2
81 IF ( PTLSQ .LE. 0.D0 ) THEN
82 IFLGLD = 1
83 RETURN
84 ENDIF
85 PCMTAR = SQRT(PTLSQ)
86* YR(2) = -0.5D0 * LOG( (ECMTAR+PCMTAR) / (ECMTAR-PCMTAR) )
87 YR(2) = - LOG( (ECMTAR+PCMTAR) / TMAS(2) )
88C RAPIDITY OF DIFFRACTING PROJECTILE
89 CALL RMMAR( RD,1,1 )
90 IF ( RD(1) .GE. 0.5 ) THEN
91 YR(1) = RANNOR( POSC2, WIDC2 ) + YY0
92 ELSE
93 YR(1) = RANNOR(-POSC2, WIDC2 ) + YY0
94 ENDIF
95
96 ELSE
97C TARGET DIFFRACTION; CALCULATE PROJECTILE RAPIDITY USING PROJECTILE
98C ENERGY ECMPRO AND LONGITUDINAL MOMENTUM PLPRO IN THE C.M. SYSTEM
99 ECMPRO = (ECMDPM**2 -ECMDIF**2 +TMAS(1)**2) / (2.D0*ECMDPM)
100 PPLSQ = ECMPRO**2 - TMAS(1)**2
101 IF ( PPLSQ .LE. 0.D0 ) THEN
102 IFLGLD = 1
103 RETURN
104 ENDIF
105 PCMPRO = SQRT(PPLSQ)
106* YR(1) = 0.5D0 * LOG( (ECMPRO+PCMPRO) / (ECMPRO-PCMPRO) )
107 YR(1) = LOG( (ECMPRO+PCMPRO) / TMAS(1) )
108C RAPIDITY OF DIFFRACTING TARGET NUCLEON
109 CALL RMMAR( RD,1,1 )
110 IF ( RD(1) .GE. 0.5 ) THEN
111 YR(2) = RANNOR( POSC2, WIDC2 ) + YY0
112 ELSE
113 YR(2) = RANNOR(-POSC2, WIDC2 ) + YY0
114 ENDIF
115 ENDIF
116
117 IF ( DEBUG ) WRITE(MDEBUG,*) 'LEADDF: YR(2),YR(1)=',
118 * SNGL(YR(2)),SNGL(YR(1))
119 IFLGLD = 0
120 RETURN
121 END
Note: See TracBrowser for help on using the repository browser.