source: branches/start/MagicSoft/Simulation/Corsika/Mmcs/box63.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.1 KB
Line 
1 SUBROUTINE BOX63
2
3C-----------------------------------------------------------------------
4C
5C NUCLEON OR ANTINUCLEON INTERACTIONS
6C TWO HEAVY ISOBARS
7C INCLUDES ANNIHILATION
8C THIS SUBROUTINE IS CALLED FROM NUCINT
9C-----------------------------------------------------------------------
10
11 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
12*KEEP,NCOUNT.
13 COMMON /NCOUNT/ NCOUN
14 INTEGER NCOUN(8)
15*KEEP,PARPAR.
16 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
17 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
18 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
19 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
20 INTEGER ITYPE,LEVL
21*KEEP,PARPAE.
22 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
23 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
24 * (CURPAR(4), PHI ), (CURPAR(5), H ),
25 * (CURPAR(6), T ), (CURPAR(7), X ),
26 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
27 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
28 * (CURPAR(12),ECM )
29*KEEP,RANDPA.
30 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
31 DOUBLE PRECISION FAC,U1,U2
32 REAL RD(3000)
33 INTEGER ISEED(103,10),NSEQ
34 LOGICAL KNOR
35*KEEP,RUNPAR.
36 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
37 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
38 * MONIOU,MDEBUG,NUCNUC,
39 * CETAPE,
40 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
41 * N1STTR,MDBASE,
42 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
43 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
44 * ,GHEISH,GHESIG
45 COMMON /RUNPAC/ DSN,HOST,USER
46 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
47 REAL STEPFC
48 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
49 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
50 * N1STTR,MDBASE
51 INTEGER CETAPE
52 CHARACTER*79 DSN
53 CHARACTER*20 HOST,USER
54
55 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
56 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
57 * ,GHEISH,GHESIG
58*KEEP,SIGM.
59 COMMON /SIGM/ SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
60 DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
61*KEND.
62
63C-----------------------------------------------------------------------
64
65 IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
66 444 FORMAT(' BOX63 : CURPAR=',1P,9E10.3)
67
68C ANNIHILATION
69 IF ( ITYPE .EQ. 15 .OR. ITYPE .EQ. 25 ) THEN
70 NCOUN(7) = NCOUN(7) + 1
71 CALL RMMAR( RD,1,1 )
72 IF ( RD(1)*SIGMA .LE. SIGANN ) THEN
73 NCOUN(8) = NCOUN(8) + 1
74 CALL NIHILA
75 RETURN
76 ENDIF
77 ENDIF
78
79C INTERACTION (ISOBAR EXCITATION)
80C SELECT HEAVY ISOBAR MASSES
81 CA = C(4)
82 CB = C(4)
83
84C HEAVY ISOBAR BACKWARD
85 CALL ISOBAR( ECM,1,CA,CB,3 )
86
87C HEAVY ISOBAR FORWARD
88 CALL ISOBAR( ECM,0,CB,CA,3 )
89
90 RETURN
91 END
Note: See TracBrowser for help on using the repository browser.