Protections against nprim = 0
[u/mrichter/AliRoot.git] / TFluka / cmpips.f
CommitLineData
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
9beb5e16 39 if (ntrack .eq. 0) THEN
40* WRITE(6,*) "Warning ntrack = 0", NALLD0, STEPID, STEPTT, STEP
41 RETURN
42 ENDIF
da6f1a87 43* +-------------------------------------------------------------------*
44* | Beginning of a step:
45 IF ( LBGSTP ) THEN
46 NSTART = 1
47 CUMTTR (0) = ZERZER
48 DO 1000 I = 1, NTRACK
49 CUMTTR (I) = CUMTTR (I-1) + TTRACK (I)
50 1000 CONTINUE
51 CRVCRR = STEP / CUMTTR (NTRACK)
52 END IF
53* |
54* +-------------------------------------------------------------------*
1234b40a 55 NRNGEN = MIN ( NALLDL, MXALLD ) - NALLD0
da6f1a87 56 IF ( NRNGEN .LE. 0 ) RETURN
57 CALL FLRNLP ( RNDVEC, NRNGEN )
58* The previous line can be substituted by:
59* DO 1400 I = 1, NRNGEN
60* RNDVEC (I) = FLRNDM (RNDPOI)
61*1400 CONTINUE
62 CALL RORDIN ( RNDVEC, INDVEC, NRNGEN )
63* +-------------------------------------------------------------------*
64* | Loop on primary electrons:
65 DO 5000 I = 1, NRNGEN
66 TTRACR = ( STEPTT + RNDVEC (I) * STEPID ) / CRVCRR
67 NSTAR0 = NSTART
68 DO 3000 J = NSTAR0, NTRACK
69 IF ( TTRACR .LT. CUMTTR (J) ) THEN
70 NSTART = J
71 REDUC = ( CUMTTR (J) - TTRACR ) / TTRACK (J)
72 GO TO 4000
73 END IF
74 3000 CONTINUE
75 CALL FLABRT ( 'CMPIPS', '3000-CONTINUE' )
76 4000 CONTINUE
77 IF ( REDUC .LT. ZERZER .OR. REDUC .GT. ONEONE )
78 & CALL FLABRT ( 'CMPIPS', 'INVALID REDUC' )
79 K = I + NALLD0
80 XALLDL (K) = REDUC * ( XTRACK (NSTART) - XTRACK (NSTART-1) )
81 & + XTRACK (NSTART-1)
82 YALLDL (K) = REDUC * ( YTRACK (NSTART) - YTRACK (NSTART-1) )
83 & + YTRACK (NSTART-1)
84 ZALLDL (K) = REDUC * ( ZTRACK (NSTART) - ZTRACK (NSTART-1) )
85 & + ZTRACK (NSTART-1)
86 5000 CONTINUE
87* |
88* +-------------------------------------------------------------------*
89 RETURN
90*=== End of subroutine Cmpips =========================================*
91 END
92