| 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 | |
git://git.uio.no / u / mrichter / AliRoot.git / blame