source: trunk/MagicSoft/Simulation/Corsika/Mmcs/ptrans.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: 3.8 KB
Line 
1 DOUBLE PRECISION FUNCTION PTRANS( DUMMY )
2
3C-----------------------------------------------------------------------
4C TRANS(VERSE MOMENTUM)
5C
6C RANDOM SELECTION OF TRANSVERSE MOMENTUM
7C DISTRIBUTION IS OF FORM X*EXP(-X)
8C THIS FUNCTION IS CALLED FROM BOX60, BOX65, BOX70, HMESON, ISOBAR,
9C NIHILA, PIGEN1, PIGEN2, SINGLE, AND VHMESO
10C ARGUMENT:
11C DUMMY = DUMMY (FOR HISTORICAL REASONS)
12C
13C CHANGES : J. KNAPP IK1 FZK KARLSRUHE
14C-----------------------------------------------------------------------
15
16 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
17*KEEP,PARPAR.
18 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
19 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
20 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
21 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
22 INTEGER ITYPE,LEVL
23*KEEP,PARPAE.
24 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
25 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
26 * (CURPAR(4), PHI ), (CURPAR(5), H ),
27 * (CURPAR(6), T ), (CURPAR(7), X ),
28 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
29 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
30 * (CURPAR(12),ECM )
31*KEEP,RANDPA.
32 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
33 DOUBLE PRECISION FAC,U1,U2
34 REAL RD(3000)
35 INTEGER ISEED(103,10),NSEQ
36 LOGICAL KNOR
37*KEEP,RUNPAR.
38 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
39 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
40 * MONIOU,MDEBUG,NUCNUC,
41 * CETAPE,
42 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
43 * N1STTR,MDBASE,
44 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
45 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
46 * ,GHEISH,GHESIG
47 COMMON /RUNPAC/ DSN,HOST,USER
48 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
49 REAL STEPFC
50 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
51 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
52 * N1STTR,MDBASE
53 INTEGER CETAPE
54 CHARACTER*79 DSN
55 CHARACTER*20 HOST,USER
56
57 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
58 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
59 * ,GHEISH,GHESIG
60*KEND.
61
62 REAL GX(0:50),HX(0:50)
63 SAVE GX,HX,DX,FIRST
64 LOGICAL FIRST
65C DX IS STEPSIZE FOR APPROXIMATING CURVE
66 DATA FIRST / .TRUE. /, DX / 0.5D0 /
67C-----------------------------------------------------------------------
68
69C IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRANS:'
70
71C COMPUTE FUNCTION VALUES AND INTEGRAL OF STEP FUNCTION H(X)
72C APPROXIMATING Y(X) = X * EXP(1-X) WITH H(X) > Y(X)
73 IF ( FIRST ) THEN
74 FIRST = .FALSE.
75 IMAX = C(34) / DX
76 GX(0) = 0.D0
77 HX(0) = DX*EXP(1.D0-DX)
78 DO 2 I = 1,IMAX
79 X = I*DX
80 IF ( X .LT. 1.D0 ) X = X + DX
81 HX(I) = X*EXP(1.D0-X)
82 GX(I) = GX(I-1) + HX(I-1)
83 2 CONTINUE
84 SUMI = 1.D0 / GX(IMAX)
85 DO 3 I = 1,IMAX
86 GX(I) = GX(I) * SUMI
87 3 CONTINUE
88 ENDIF
89
90C-----------------------------------------------------------------------
91C GET RANDOM VARIABLE DISTRIBUTED AS HX(X)
92 11 CONTINUE
93 CALL RMMAR( RD,2,1 )
94 I = 0
95 1 CONTINUE
96 I = I+1
97 IF ( GX(I) .LT. RD(1) ) GOTO 1
98 XX = ( (RD(1)-GX(I-1))/(GX(I)-GX(I-1)) + I-1 ) * DX
99 ZZ = HX(I-1)
100C GET RANDOM VARIABLE DISTRIBUTED AS Y(X) BY REJECTION METHOD
101 TT = XX * EXP(1.-XX)
102 IF ( RD(2)*ZZ .GT. TT ) GOTO 11
103
104C GET REQUIRED PEAK VALUE
105 PTRANS = XX * C(12)
106 IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRANS: PT = ',SNGL(PTRANS)
107
108 RETURN
109 END
Note: See TracBrowser for help on using the repository browser.