This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgbttt.F
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