This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdtr1.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:20:28  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
11 *-- Author :
12       SUBROUTINE GDTR1(JM,J1,J2,IER)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       Scan one level of JVOLUM structure                       *
17 C.    *                                                                *
18 C.    *       JM = mother node (input)                                 *
19 C.    *       J1 = starting node (input)                               *
20 C.    *       J2 = ending node (output)                                *
21 C.    *       IER  = error flag to detect nodes overflow (output)      *
22 C.    *                                                                *
23 C.    *    ==>Called by : GDTR2                                        *
24 C.    *       Author : P.Zanarini   *********                          *
25 C.    *                                                                *
26 C.    ******************************************************************
27 C.
28 #include "geant321/gcbank.inc"
29 #include "geant321/gcdraw.inc"
30 #include "geant321/gcunit.inc"
31       CHARACTER*4 NAME, ISON
32       DIMENSION N(50),IH(50)
33       SAVE NUMCHK,MAXCHK
34       DATA NUMCHK/4/,MAXCHK/50/
35 C.
36 C.    ------------------------------------------------------------------
37 C.
38       IER=0
39 C
40       IF (NUMCHK.GT.MAXCHK) GO TO 140
41 C
42       CALL UHTOC (IQ(JNAM+JM), 4, NAME, 4)
43       CALL GDNSON (NAME, NXONS, MUL)
44       IF (NXONS.EQ.0) THEN
45          IQ(JXON+JM)=0
46          J2=J1
47       ELSE
48          J2=J1+1
49          IQ(JXON+JM)=J2
50          CALL UHTOC (IQ(JNAM+JM), 4, NAME, 4)
51          CALL GDSON (1, NAME, ISON)
52          CALL UCTOH (ISON, LXON, 4, 4)
53          LOXON=LXON
54          IQ(JNAM+J2)=LXON
55          IQ(JMOT+J2)=JM
56          IF (NXONS.GT.1) THEN
57             IF (J2+NXONS.GE.MAXNOD) GO TO 130
58 C
59             JSAV=J2
60 C
61             DO 10 I=2,NXONS
62                CALL UHTOC (IQ(JNAM+JM), 4, NAME, 4)
63                CALL GDSON (I, NAME, ISON)
64                CALL UCTOH (ISON, LXON, 4, 4)
65                IF (LXON.NE.LOXON) THEN
66                   LOXON=LXON
67                   J=J2+1
68                   IQ(JBRO+J2)=J
69                   IQ(JNAM+J)=LXON
70                   IQ(JMOT+J)=JM
71                   J2=J
72                ELSE
73                   IQ(JPSM+J2)=IQ(JPSM+J2)+1
74                ENDIF
75    10       CONTINUE
76 C
77             DO 20 K=JSAV,J2
78                CALL UHTOC (IQ(JNAM+K), 4, NAME, 4)
79                CALL GFATT (NAME, 'SEEN', KVAL)
80                IF (KVAL.EQ.-3) GO TO 30
81    20       CONTINUE
82 C
83             GO TO 120
84 C
85    30       I=JSAV
86 C
87    40       CONTINUE
88 C
89             DO 50  K=1,NUMCHK
90                N(K)=IQ(JNAM+I+K-1)
91                IH(K)=N(K)/65536
92 #if defined(CERNLIB_VAX)||defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT)
93                IH(K)=N(K)-IH(K)*65536
94 #endif
95                IF (IH(1).NE.IH(K)) GO TO 90
96    50       CONTINUE
97             DO 70  K=1,NUMCHK
98                DO 60  KK=K+2,NUMCHK
99                   IF (IQ(JNAM+K).EQ.IQ(JNAM+KK)) GO TO 90
100    60          CONTINUE
101    70       CONTINUE
102             DO 80  K=I+2,J2
103                IQ(JNAM+K-1)=IQ(JNAM+K)
104    80       CONTINUE
105             J2=J2-1
106             IQ(JPSM+I+1)=IQ(JPSM+I+1)+1
107             GO TO 100
108    90       CONTINUE
109             I=I+1
110   100       CONTINUE
111 C
112             IF (J2.GT.I+NUMCHK-2) GO TO 40
113 C
114             DO 110 K=JSAV+1,J2-1
115             IF (IQ(JPSM+K).GT.1) CALL UCTOH('    ',IQ(JNAM+K),4,4)
116   110       CONTINUE
117 C
118   120       CONTINUE
119 C
120          ENDIF
121          IQ(JBRO+J2)=0
122       ENDIF
123       IQ(JSCA+JM)=1
124       GO TO 999
125   130 WRITE (CHMAIL,1000) MAXNOD
126       CALL GMAIL(0,0)
127       IER=1
128       GO TO 999
129   140 WRITE (CHMAIL,1100)
130       CALL GMAIL(0,0)
131       IER=1
132  1000 FORMAT (' GDTR1 : MAXNOD = ',I5,' - TREE OVERFLOW')
133  1100 FORMAT (' GDTR1 : NUMCHK > MAXCHK - TREE NOT EXECUTED')
134   999 RETURN
135       END