]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1995/10/24 10:21:00 cernlib | |
6 | * Geant | |
7 | * | |
8 | * | |
9 | #include "geant321/pilot.h" | |
10 | *CMZ : 3.21/02 29/03/94 15.41.38 by S.Giani | |
11 | *-- Author : | |
12 | SUBROUTINE SETTRK(NTR) | |
13 | C | |
14 | C *** FILL THE STACK VIA COMMON /EVENT/ *** | |
15 | C *** INSTEAD OF THE USERWORD, THE PARTICLE INDEX IS STORED *** | |
16 | C *** NVE 01-MAR-1988 CERN GENEVA *** | |
17 | C | |
18 | C ORIGIN : H.FESEFELDT (10-NOV-1983) | |
19 | C | |
20 | #include "geant321/gcking.inc" | |
21 | #include "geant321/s_defcom.inc" | |
22 | C | |
23 | C --- CHECK PV ARRAY BOUNDARY --- | |
24 | IF(NTR .LE. MXGKPV) GOTO 10 | |
25 | PRINT 1000,NTR | |
26 | 1000 FORMAT(' *SETTRK* NTR = ',I3,' WOULD ADRESS OUTSIDE PV ARRAY'/ | |
27 | $ ' ===> TRACK WILL NOT BE PUT ON STACK AND WILL BE LOST') | |
28 | GO TO 9999 | |
29 | C | |
30 | C --- CHECK TOTAL NUMBER OF PRODUCED PARTICLES --- | |
31 | 10 CONTINUE | |
32 | NVEDUM=NTOT+1 | |
33 | IF(NVEDUM .LE. MXEVEN) GOTO 20 | |
34 | IF(NVEDUM .EQ. MXEVEN+1) PRINT 1001, NVEDUM,MXEVEN | |
35 | 1001 FORMAT(' *SETTRK* STORAGE OF PARTICLE NO. ',I4, 'NOT ALLOWED'/ | |
36 | $ ' MAXIMUM NUMBER OF GENERATED PARTICLES IS ',I4/ | |
37 | $ ' ===> FROM NOW ON ALL GENERATED PARTICLES WILL BE DISCARDED') | |
38 | GO TO 9999 | |
39 | C | |
40 | C --- STORE GENERATED PARTICLE ON THE STACK --- | |
41 | 20 CONTINUE | |
42 | EVE(NEXT )=XEND | |
43 | EVE(NEXT+ 1)=YEND | |
44 | EVE(NEXT+ 2)=ZEND | |
45 | EVE(NEXT+ 3)=RCA | |
46 | EVE(NEXT+ 4)=RCE | |
47 | EVE(NEXT+ 5)=PV(5,NTR) | |
48 | EVE(NEXT+ 6)=PV(6,NTR) | |
49 | EVE(NEXT+ 7)=PV(7,NTR) | |
50 | EVE(NEXT+ 8)=PV(1,NTR) | |
51 | EVE(NEXT+ 9)=PV(2,NTR) | |
52 | EVE(NEXT+10)=PV(3,NTR) | |
53 | EVE(NEXT+11)=PV(8,NTR) | |
54 | NEXT=NEXT+12 | |
55 | NTOT=NTOT+1 | |
56 | NEXT1=NEXT-12 | |
57 | NEXT2=NEXT-1 | |
58 | NTOT1=NTOT-1 | |
59 | IF(NPRT(3).OR.NPRT(4).OR.NPRT(5)) | |
60 | $ WRITE(NEWBCD,2000) NTOT1,(EVE(I),I=NEXT1,NEXT2) | |
61 | 2000 FORMAT(' *SETTRK* TRACK ON STACK:',I5,2X,3F8.2,1X,2F7.0,1X, | |
62 | $ F8.3,1X,F3.0,1X,F6.0,1X,3F8.3,1X,F10.0) | |
63 | C | |
64 | 9999 CONTINUE | |
65 | RETURN | |
66 | END |