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 | |
---|