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