source: trunk/MagicSoft/Simulation/Corsika/Mmcs/box65.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.0 KB
Line 
1 SUBROUTINE BOX65
2
3C-----------------------------------------------------------------------
4C
5C PION INTERACTIONS
6C ELASTIC SCATTERING, NO ENERGY LOSS
7C THIS SUBROUTINE IS CALLED FROM NUCINT
8C-----------------------------------------------------------------------
9
10 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
11*KEEP,CONST.
12 COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
13 DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
14*KEEP,PAM.
15 COMMON /PAM/ PAMA,SIGNUM
16 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
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
62C-----------------------------------------------------------------------
63
64 IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
65 444 FORMAT(' BOX65 : CURPAR=',1P,9E10.3)
66
67C SCATTERING OF SINGLE PARTICLE
68 DO 1 I = 1,8
69 SECPAR(I) = CURPAR(I)
70 1 CONTINUE
71 PT = PTRANS(DUMMY)
72 PLLAB2 = PAMA(8)**2 * (GAMMA**2 - 1.D0)
73 CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
74 IF ( CTHETA .LT. C(27) ) RETURN
75 CALL RMMAR( RD,1,1 )
76 CALL ADDANG( COSTHE,PHI, CTHETA,RD(1)*PI2, SECPAR(3),SECPAR(4) )
77C KILL BACKWARD GOING PARTICLES
78 IF ( SECPAR(3) .LT. C(29) ) RETURN
79
80 CALL TSTACK
81
82 RETURN
83 END
Note: See TracBrowser for help on using the repository browser.