source: ZHANGProjects/ICOSIM/CPP/trunk/flukaIntegration/fluka/fluscw.f @ 2

Last change on this file since 2 was 2, checked in by zhangj, 10 years ago

Initial import
File size: 5.4 KB
Line 
1*$ CREATE FLUSCW.FOR
2*COPY FLUSCW
3*                                                                      *
4*=== fluscw ===========================================================*
5*                                                                      *
6      DOUBLE PRECISION FUNCTION FLUSCW ( IJ    , PLA   , TXX   , TYY   ,
7     &                                   TZZ   , WEE   , XX    , YY    ,
8     &                                   ZZ    , NREG  , IOLREG, LLO   ,
9     &                                   NSURF )
10
11      INCLUDE '(DBLPRC)'
12      INCLUDE '(DIMPAR)'
13      INCLUDE '(IOUNIT)'
14*
15*----------------------------------------------------------------------*
16*                                                                      *
17*     Copyright (C) 1989-2005      by    Alfredo Ferrari & Paola Sala  *
18*     All Rights Reserved.                                             *
19*                                                                      *
20*     New version of Fluscw for FLUKA9x-FLUKA200x:                     *
21*                                                                      *
22*     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!     *
23*     !!! This is a completely dummy routine for Fluka9x/200x. !!!     *
24*     !!! The  name has been kept the same as for older  Fluka !!!     *
25*     !!! versions for back-compatibility, even though  Fluscw !!!     *
26*     !!! is applied only to estimators which didn't exist be- !!!     *
27*     !!! fore Fluka89.                                        !!!     *
28*     !!! User  developed versions  can be used for  weighting !!!     *
29*     !!! flux-like quantities at runtime                      !!!     *
30*     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!     *
31*                                                                      *
32*     Input variables:                                                 *
33*                                                                      *
34*           Ij = (generalized) particle code (Paprop numbering)        *
35*          Pla = particle laboratory momentum (GeV/c) (if > 0),        *
36*                or kinetic energy (GeV) (if <0 )                      *
37*    Txx,yy,zz = particle direction cosines                            *
38*          Wee = particle weight                                       *
39*     Xx,Yy,Zz = position                                              *
40*         Nreg = (new) region number                                   *
41*       Iolreg = (old) region number                                   *
42*          Llo = particle generation                                   *
43*        Nsurf = transport flag (ignore!)                              *
44*                                                                      *
45*     Output variables:                                                *
46*                                                                      *
47*       Fluscw = factor the scored amount will be multiplied by        *
48*       Lsczer = logical flag, if true no amount will be scored        *
49*                regardless of Fluscw                                  *
50*                                                                      *
51*     Useful variables (common SCOHLP):                                *
52*                                                                      *
53*     Flux like binnings/estimators (Fluscw):                          *
54*          ISCRNG = 1 --> Boundary crossing estimator                  *
55*          ISCRNG = 2 --> Track  length     binning                    *
56*          ISCRNG = 3 --> Track  length     estimator                  *
57*          ISCRNG = 4 --> Collision density estimator                  *
58*          ISCRNG = 5 --> Yield             estimator                  *
59*          JSCRNG = # of the binning/estimator                         *
60*                                                                      *
61*----------------------------------------------------------------------*
62*
63
64      INCLUDE '(SCOHLP)'
65      INCLUDE '(USRBDX)'
66      INCLUDE '(PAPROP)'
67      INCLUDE '(BEAMCM)'
68      INCLUDE 'flukaio.inc'
69
70      INTEGER ILASTID
71      SAVE ILASTID
72      DATA ILASTID / 0 /
73
74      INTEGER IDP0
75      INTEGER IGEN0
76
77*     Send back protons
78      IF ( ISCRNG .EQ.1 .AND. TITUSX(JSCRNG) .EQ. "BACK2ICO" ) THEN
79
80*       If generation bigger than 1 generate new particle id
81        IF (LLO.GT.1) THEN
82          IDP0 = IDP
83          IDGEN0 = IDGEN
84
85          IDGEN = IDP
86
87          IF(ILASTID.EQ.IDP) THEN
88            IDP = IDP + 10000
89          END IF
90        ENDIF
91
92* don't overwrite PLA...
93
94        IF ( PLA .GT. 0.0D+00 ) THEN
95           PSCO = PLA
96        ELSE
97*          new formulation (equivalent to the old one),
98*          without subtractions! (more precise...)
99*          NB: PLA < 0.0 !!
100           PSCO = SQRT( -PLA * ( -PLA + TWOTWO * AM(IJ) ) )
101        ENDIF
102
103*        WRITE(LUNOUT,*)'END:',IDP, IBARCH(IJ), ICHRGE(IJ)
104
105        N = NTSENDP(
106     &            ICID,
107     &            IDP, IDGEN, WEE,
108     &            XX - XBEAM, YY - YBEAM, ZZ - ZBEAM, 
109     &            TXX, TYY, TZZ,
110     &            IBARCH(IJ), ICHRGE(IJ),
111     &            AM(IJ), PSCO,
112     &            T)
113
114        IF (LLO.GT.1) THEN
115          IDP = IDP0
116          IDGEN = IDGEN0
117        ENDIF
118
119        ILASTID = IDP
120      ENDIF
121
122
123      FLUSCW = ONEONE
124      LSCZER = .FALSE.
125
126      RETURN
127
128*=== End of function Fluscw ===========================================*
129      END
130
131
Note: See TracBrowser for help on using the repository browser.