]>
Commit | Line | Data |
---|---|---|
da6f1a87 | 1 | *$ CREATE CMPIPS.FOR |
2 | *COPY CMPIPS | |
3 | * * | |
4 | *=== Cmpips ===========================================================* | |
5 | * * | |
6 | SUBROUTINE CMPIPS ( NALLD0, STEPID, STEPTT, STEP ) | |
7 | ||
8 | INCLUDE '(DBLPRC)' | |
9 | INCLUDE '(DIMPAR)' | |
10 | INCLUDE '(IOUNIT)' | |
11 | * | |
12 | *----------------------------------------------------------------------* | |
13 | * * | |
14 | * Copyright (C) 2005-2006: Alfredo Ferrari * | |
15 | * All rights reserved * | |
16 | * * | |
17 | * * | |
18 | * CoMpute Primary Ionization PoSitions: * | |
19 | * * | |
20 | * Created on 11 november 2005 by Alfredo Ferrari * | |
21 | * INFN - Milan * | |
22 | * * | |
23 | * Last change on 05-oct-06 by Alfredo Ferrari * | |
24 | * * | |
25 | * * | |
26 | * Input variables: * | |
27 | * * | |
28 | *----------------------------------------------------------------------* | |
29 | * | |
30 | INCLUDE '(ALLDLT)' | |
31 | INCLUDE '(TRACKR)' | |
32 | * | |
33 | LOGICAL LBGSTP | |
34 | DIMENSION CUMTTR (0:MXTRCK), RNDVEC (MXALLD), INDVEC (MXALLD) | |
35 | * | |
36 | SAVE NSTART, CUMTTR | |
37 | * | |
da6f1a87 | 38 | LBGSTP = STEPTT .LT. AZRZRZ |
39 | * +-------------------------------------------------------------------* | |
40 | * | Beginning of a step: | |
41 | IF ( LBGSTP ) THEN | |
42 | NSTART = 1 | |
43 | CUMTTR (0) = ZERZER | |
44 | DO 1000 I = 1, NTRACK | |
45 | CUMTTR (I) = CUMTTR (I-1) + TTRACK (I) | |
46 | 1000 CONTINUE | |
47 | CRVCRR = STEP / CUMTTR (NTRACK) | |
48 | END IF | |
49 | * | | |
50 | * +-------------------------------------------------------------------* | |
1234b40a | 51 | NRNGEN = MIN ( NALLDL, MXALLD ) - NALLD0 |
da6f1a87 | 52 | IF ( NRNGEN .LE. 0 ) RETURN |
53 | CALL FLRNLP ( RNDVEC, NRNGEN ) | |
54 | * The previous line can be substituted by: | |
55 | * DO 1400 I = 1, NRNGEN | |
56 | * RNDVEC (I) = FLRNDM (RNDPOI) | |
57 | *1400 CONTINUE | |
58 | CALL RORDIN ( RNDVEC, INDVEC, NRNGEN ) | |
59 | * +-------------------------------------------------------------------* | |
60 | * | Loop on primary electrons: | |
61 | DO 5000 I = 1, NRNGEN | |
62 | TTRACR = ( STEPTT + RNDVEC (I) * STEPID ) / CRVCRR | |
63 | NSTAR0 = NSTART | |
64 | DO 3000 J = NSTAR0, NTRACK | |
65 | IF ( TTRACR .LT. CUMTTR (J) ) THEN | |
66 | NSTART = J | |
67 | REDUC = ( CUMTTR (J) - TTRACR ) / TTRACK (J) | |
68 | GO TO 4000 | |
69 | END IF | |
70 | 3000 CONTINUE | |
71 | CALL FLABRT ( 'CMPIPS', '3000-CONTINUE' ) | |
72 | 4000 CONTINUE | |
73 | IF ( REDUC .LT. ZERZER .OR. REDUC .GT. ONEONE ) | |
74 | & CALL FLABRT ( 'CMPIPS', 'INVALID REDUC' ) | |
75 | K = I + NALLD0 | |
76 | XALLDL (K) = REDUC * ( XTRACK (NSTART) - XTRACK (NSTART-1) ) | |
77 | & + XTRACK (NSTART-1) | |
78 | YALLDL (K) = REDUC * ( YTRACK (NSTART) - YTRACK (NSTART-1) ) | |
79 | & + YTRACK (NSTART-1) | |
80 | ZALLDL (K) = REDUC * ( ZTRACK (NSTART) - ZTRACK (NSTART-1) ) | |
81 | & + ZTRACK (NSTART-1) | |
82 | 5000 CONTINUE | |
83 | * | | |
84 | * +-------------------------------------------------------------------* | |
85 | RETURN | |
86 | *=== End of subroutine Cmpips =========================================* | |
87 | END | |
88 |