source: trunk/MagicSoft/Simulation/Corsika/Mmcs/box61.f@ 343

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