1 | SUBROUTINE LEADDF( IFLGLD )
|
---|
2 |
|
---|
3 | C-----------------------------------------------------------------------
|
---|
4 | C LEAD(ING PARTICLE RAPIDITY FOR) D(I)F(FFRACTING SYSTEM)
|
---|
5 | C
|
---|
6 | C SELECTS THE RAPIDITY OF THE (ANTI)LEADING PARTICLES IN CASE OF
|
---|
7 | C DIFFRACTION. THE NON-DIFFRACTING (ANTI)LEADER GETS ITS RAPIDITY
|
---|
8 | C FROM THE REMAINDER ENERGY, THE DIFFRACTING (ANTI)LEADER GETS ITS
|
---|
9 | C RAPIDITY FROM THE GAUSSIAN (STRING) OF THE DECAYING DIFFRACTIVE MASS.
|
---|
10 | C THIS SUBROUTINE IS CALLED FROM HDPM
|
---|
11 | C ARGUMENT:
|
---|
12 | C IFLGLD = 0 RAPIDITY SELECTION SUCCESSFUL
|
---|
13 | C = 1 RAPIDITY SELECTION NOT SUCCESSFULL
|
---|
14 | C-----------------------------------------------------------------------
|
---|
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 |
|
---|
71 | C-----------------------------------------------------------------------
|
---|
72 |
|
---|
73 | IF ( DEBUG ) WRITE(MDEBUG,*) 'LEADDF: LEPAR1,LEPAR2=',
|
---|
74 | * LEPAR1,LEPAR2
|
---|
75 |
|
---|
76 | IF ( YY0 .GT. 0.D0 ) THEN
|
---|
77 | C PROJECTILE DIFFRACTION; CALCULATE TARGET RAPIDITY USING TARGET
|
---|
78 | C 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) )
|
---|
88 | C 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
|
---|
97 | C TARGET DIFFRACTION; CALCULATE PROJECTILE RAPIDITY USING PROJECTILE
|
---|
98 | C 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) )
|
---|
108 | C 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
|
---|