source: trunk/MagicSoft/Simulation/Corsika/Mmcs/ptran.f@ 687

Last change on this file since 687 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: 2.9 KB
Line 
1 SUBROUTINE PTRAN( ZN,FACT,PTX,PTY )
2
3C-----------------------------------------------------------------------
4C TRAN(SVERSE MOMENTUM)
5C
6C GENERATION OF TRANSVERSE MOMENTUM FOR PARTICLES IN HDPM
7C THIS SUBROUTINE IS CALLED FROM PPARAM
8C ARGUMENTS:
9C ZN = POWER OF TRANSV. MOMENTUM FUNCTION, DEP. ON CENT.RAP.DENSITY
10C FACT = FACTOR TAKING INTO ACCOUNT PARTICLE SPECIFIC TRANSV.MOMENTUM
11C PTX = TRANSVERSE MOMENTUM IN X DIRECTION
12C PTY = TRANSVERSE MOMENTUM IN Y DIRECTION
13C
14C DESIGN : T. THOUW IK3 FZK KARLSRUHE
15C CHANGES : D. HECK IK3 FZK KARLSRUHE
16C-----------------------------------------------------------------------
17
18 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
19*KEEP,CONST.
20 COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
21 DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
22*KEEP,RANDPA.
23 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
24 DOUBLE PRECISION FAC,U1,U2
25 REAL RD(3000)
26 INTEGER ISEED(103,10),NSEQ
27 LOGICAL KNOR
28*KEEP,RUNPAR.
29 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
30 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
31 * MONIOU,MDEBUG,NUCNUC,
32 * CETAPE,
33 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
34 * N1STTR,MDBASE,
35 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
36 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
37 * ,GHEISH,GHESIG
38 COMMON /RUNPAC/ DSN,HOST,USER
39 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
40 REAL STEPFC
41 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
42 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
43 * N1STTR,MDBASE
44 INTEGER CETAPE
45 CHARACTER*79 DSN
46 CHARACTER*20 HOST,USER
47
48 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
49 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
50 * ,GHEISH,GHESIG
51*KEND.
52
53C-----------------------------------------------------------------------
54
55CC IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRAN : ZN=',SNGL(ZN)
56
57C TWO RANDOM NUMBERS
58 CALL RMMAR( RD,2,1 )
59C GENERATE <P_T> (REFERENCE??)
60 B = ZN * (ZN - 1.D0)
61 ZZ = SQRT(1.D0/RD(1) - 1.D0)
62 XPT = ZZ * SQRT(2.D0/B)
63 11 CONTINUE
64 IF ( XPT .LT. 0.5D-3 ) GOTO 22
65 X1 = 1.D0 + XPT
66 XB = X1**ZN
67 XC = 1.D0 + ZN * XPT
68 ZA = SQRT(XB/XC - 1.D0)
69 XD = (ZZ - ZA) * (X1 * 2.D0 * ZA * XC**2 ) / ( B * XPT * XB )
70 XPT = XPT + XD
71 IF ( ABS(XD) .GT. 1.D-3 ) GOTO 11
72 22 CONTINUE
73
74C 2*PI*RANDOM NUMBER FOR ANGLE PHI
75 Z = PI2 * RD(2)
76 PTX = XPT * FACT * COS(Z)
77 PTY = XPT * FACT * SIN(Z)
78
79CC IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRAN : RD(1,2),XPT=',
80CC * RD(1),RD(2),SNGL(XPT)
81
82 RETURN
83 END
Note: See TracBrowser for help on using the repository browser.