source: branches/start/MagicSoft/Simulation/Corsika/Mmcs/box70.f@ 18569

Last change on this file since 18569 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 BOX70
2
3C-----------------------------------------------------------------------
4C
5C KAON 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(' BOX70 : CURPAR=',1P,9E10.3)
66
67C ELASTIC SCATTERING
68 DO 1 I = 1,8
69 SECPAR(I) = CURPAR(I)
70 1 CONTINUE
71 PT = PTRANS(DUMMY)
72 PLLAB2 = PAMA(ITYPE)**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) )
77 IF ( SECPAR(3) .LT. C(29) ) RETURN
78
79 CALL TSTACK
80
81 RETURN
82 END
Note: See TracBrowser for help on using the repository browser.