]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/cgpack/cgbttt.F
Some function moved to AliZDC
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgbttt.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:19:42 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.31 by S.Giani
11*-- Author :
12 SUBROUTINE CGBTTT(WHAT,TMIN,TMAX,NT,NEDGE)
13************************************************************************
14* *
15* Name: CGBTTT *
16* Author: E. Chernyaev Date: 14.03.89 *
17* Revised: *
18* *
19* Function: Prepare list of T-intervals *
20* *
21* References: none *
22* *
23* Input: WHAT - flag: what is need ('GT','GE','LT','LE') *
24* TMIN - min of T *
25* TMAX - max of T *
26* NT - number of T-points *
27* *
28* Output: NEDGE - number of edges *
29* *
30* Errors: none *
31* *
32************************************************************************
33#include "geant321/cgcedg.inc"
34#include "geant321/cgdelt.inc"
35 CHARACTER*2 WHAT
36 CHARACTER*3 STATUS
37*-
38 TDEL = 4.*EEWOR
39 NE = 0
40 IF (NT .GE. 2) GOTO 100
41* IF (NT .EQ. 1) PRINT *,' CGBTTT: Number of T=1'
42 IF (WHAT(1:1) .EQ. 'L') GOTO 999
43 TTT(1,1) = TMIN
44 TTT(2,1) = TMAX
45 ITTT(1) = 0
46 NE = 1
47 GOTO 999
48*
49** S O R T I N T E R S E C T I O N P O I N T S
50*
51 100 DO 120 I=1,NT-1
52 DO 110 J=I,1,-1
53 IF (TTT(1,J+1) .GE. TTT(1,J)) GOTO 120
54 T1 = TTT(1,J+1)
55 T2 = TTT(2,J+1)
56 TTT(1,J+1) = TTT(1,J)
57 TTT(2,J+1) = TTT(2,J)
58 TTT(1,J) = T1
59 TTT(2,J) = T2
60 110 CONTINUE
61 120 CONTINUE
62*
63** F I N D S I G N O F 1 - S T P O I N T
64*
65 200 I1NEG = 0
66 I1POS = 0
67 I1ZBEG = 0
68 I1ZEND = 0
69 I1SIGN =-1
70 T1 = TTT(1,1)
71 DO 220 I=1,NT
72 J = I
73 IF (TTT(1,I)-T1 .LE. TDEL) GOTO 210
74 IF (I1NEG .NE. I1POS) GOTO 240
75 T1 = TTT(1,I)
76 I1NEG = 0
77 I1POS = 0
78 I1ZBEG = 0
79 I1ZEND = 0
80 210 IF (TTT(2,I) .EQ. -1.) I1NEG = 1
81 IF (TTT(2,I) .EQ. +1.) I1POS = 1
82 IF (TTT(2,I) .EQ. 0.) I1ZBEG = 1
83 IF (TTT(2,I) .EQ. 2.) I1ZEND = 1
84 220 CONTINUE
85 IF (I1NEG .EQ. I1POS) GOTO 250
86 240 IF (I1NEG .EQ. 1) I1SIGN =-1
87 IF (I1POS .EQ. 1) I1SIGN =+1
88 IF (I1ZEND.EQ.1 .AND. I1ZBEG.EQ.0) I1SIGN =-I1SIGN
89*
90 250 NNTT = NT
91 IF (WHAT(1:1) .EQ. 'L') GOTO 300
92 NNTT = NT + 1
93 TTT(1,NNTT) =+99999.
94 TTT(2,NNTT) = I1SIGN
95*
96** P R E P A R E L I S T O F I N T E R V A L S
97*
98 300 T2 = -99999.
99 I2NEG = 0
100 I2POS = 0
101 I2ZBEG = 0
102 I2ZEND = 0
103 IF (I1SIGN .LT. 0) I2POS = 1
104 IF (I1SIGN .GT. 0) I2NEG = 1
105 NE = 0
106 ITCUR = 1
107 STATUS = 'OUT'
108* S T A R T O F S E A R C H F O R N E X T P O I N T
109 310 T1 = T2
110 I1NEG = I2NEG
111 I1POS = I2POS
112 I1ZBEG = I2ZBEG
113 I1ZEND = I2ZEND
114 320 IF (ITCUR .GT. NNTT) GOTO 600
115 T2 = TTT(1,ITCUR)
116 I2NEG = 0
117 I2POS = 0
118 I2ZBEG = 0
119 I2ZEND = 0
120 330 IF (TTT(2,ITCUR) .EQ.-1.) I2NEG = 1
121 IF (TTT(2,ITCUR) .EQ.+1.) I2POS = 1
122 IF (TTT(2,ITCUR) .EQ. 0.) I2ZBEG = 1
123 IF (TTT(2,ITCUR) .EQ. 2.) I2ZEND = 1
124 ITCUR = ITCUR + 1
125 IF (ITCUR .GT. NNTT) GOTO 400
126 IF (TTT(1,ITCUR)-T2 .LE. TDEL) GOTO 330
127* N E X T P O I N T I S F O U N D E D
128 400 T2 = (T2+TTT(1,ITCUR-1))/2.
129 IF (I1ZBEG .NE. 0) GOTO 410
130 IF (I2ZBEG*I2ZEND .NE. 0) GOTO 420
131 IF (I2POS*I2NEG .NE. 0) GOTO 530
132 IF (I1SIGN.GT.0 .AND. I2POS.GT.0) GOTO 510
133 IF (I1SIGN.LT.0 .AND. I2NEG.GT.0) GOTO 510
134 IF (I1SIGN.GT.0 .AND. I2NEG.GT.0) GOTO 520
135 IF (I1SIGN.LT.0 .AND. I2POS.GT.0) GOTO 520
136 GOTO 310
137* B O U N D A R Y E D G E
138 410 NE = NE + 1
139 TTT(1,NE) = T1
140 TTT(2,NE) = T2
141 ITTT(NE) = 1
142 IF (I2ZEND .EQ. 0) I2ZBEG = 1
143 405 IF (I1SIGN.GT.0 .AND. I2POS.GT.0) STATUS = 'IN '
144 IF (I1SIGN.LT.0 .AND. I2NEG.GT.0) STATUS = 'IN '
145 IF (I1SIGN.GT.0 .AND. I2NEG.GT.0) STATUS = 'OUT'
146 IF (I1SIGN.LT.0 .AND. I2POS.GT.0) STATUS = 'OUT'
147 GOTO 310
148* V E R Y S M A L L B O U N D A R Y E D G E
149 420 IF (I2POS+I2NEG .EQ. 0) GOTO 310
150 I2ZBEG = 0
151 I2ZEND = 0
152 GOTO 405
153*
154** C O M E I N
155*
156 510 IF (STATUS .EQ. 'IN ') GOTO 511
157 IF (STATUS .EQ. 'OUT') GOTO 512
158 511 IF (WHAT(1:1) .EQ. 'L') GOTO 550
159 GOTO 310
160 512 STATUS = 'IN '
161 IF (WHAT(1:1) .EQ. 'G') GOTO 550
162 GOTO 310
163* C O M E O U T
164 520 IF (STATUS .EQ. 'IN ') GOTO 521
165 IF (STATUS .EQ. 'OUT') GOTO 522
166 521 STATUS = 'OUT'
167 IF (WHAT(1:1) .EQ. 'L') GOTO 550
168 GOTO 310
169 522 IF (WHAT(1:1) .EQ. 'L') GOTO 550
170 GOTO 310
171* C O M E I N / O U T
172 530 IF (STATUS .EQ. 'IN ') GOTO 531
173 IF (STATUS .EQ. 'OUT') GOTO 532
174 531 IF (WHAT(1:1) .EQ. 'L') GOTO 550
175 GOTO 310
176 532 IF (WHAT(1:1) .EQ. 'G') GOTO 550
177 GOTO 310
178*
179 550 NE = NE + 1
180 TTT(1,NE) = T1
181 TTT(2,NE) = T2
182 ITTT(NE) = 0
183 GOTO 310
184*
185** S K I P B O U N D A R Y E D G E S (I F N E E D)
186*
187 600 IF (NE .EQ. 0) GOTO 999
188 IF (WHAT(2:2) .EQ. 'E') GOTO 700
189 K = 0
190 DO 610 I=1,NE
191 IF (ITTT(I) .EQ. 1) GOTO 610
192 K = K + 1
193 TTT(1,K) = TTT(1,I)
194 TTT(2,K) = TTT(2,I)
195 ITTT(K) = ITTT(I)
196 610 CONTINUE
197 NE = K
198*
199 700 IF (NE .EQ. 0) GOTO 999
200 IF (TMIN .GT. TMAX) GOTO 999
201 K = 0
202 DO 710 I=1,NE
203 IF (TTT(2,I) .LE. TMIN) GOTO 710
204 IF (TTT(1,I) .GE. TMAX) GOTO 720
205 T1 = TTT(1,I)
206 T2 = TTT(2,I)
207 IF (T1 .LT. TMIN) T1 = TMIN
208 IF (T2 .GT. TMAX) T2 = TMAX
209 IF (T2-T1 .LT. TDEL) GOTO 710
210 K = K + 1
211 TTT(1,K) = T1
212 TTT(2,K) = T2
213 ITTT(K) = ITTT(I)
214 710 CONTINUE
215 720 NE = K
216*
217 999 NEDGE = NE
218 RETURN
219 END