This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdcghi.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:20:20  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.26  by  S.Giani
11 *-- Author :
12       SUBROUTINE GDCGHI(IMOD,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       This routine allows :                                    *
17 C.    *                                                                *
18 C.    *          - Slicing by a plane if some cut has been set,        *
19 C.    *          - Clipping by any kind of volume if one or more       *
20 C.    *            clipping volumes have been defined                  *
21 C.    *          - to Insert the CG Objects into the Hidden Structure  *
22 C.    *          - to convert the CG Objects in Wire Objects           *
23 C.    *                                                                *
24 C.    *       Input Parameters:                                        *
25 C.    *                                                                *
26 C.    *          IMOD:  Number for indicating the task to be perfor-   *
27 C.    *                 med.  See GDCGOB subroutine                    *
28 C.    *          NOBJ:  Counter for CG objects                         *
29 C.    *          NWWS:  Size of Wire Structure                         *
30 C.    *          LSTEP:  N. of bodies forming each CG volume           *
31 C.    *          ISG  :  i-th body forming a Pcon or Pgon              *
32 C.    *          NTVOL: N. of bodies forming each Pcon or Pgon         *
33 C.    *          ISHAPE:Shape of CG object                             *
34 C.    *                                                                *
35 C.    *                                                                *
36 C.    *    ==>Called by : GDCGOB                                       *
37 C.    *                                                                *
38 C.    *       Authors :  J.Salt, S.Giani                               *
39 C.    ******************************************************************
40 C.
41 *
42 #include "geant321/gcbank.inc"
43 #include "geant321/gcgobj.inc"
44 #include "geant321/gcunit.inc"
45 #include "geant321/gchiln.inc"
46 #include "geant321/gcspee.inc"
47 #include "geant321/gcmutr.inc"
48       SAVE NFIRST, NSHA, IOLDNS
49       DATA NFIRST/1/
50       DATA NSHA/0/
51       DATA IOLDNS/0/
52 *
53 *   Slicing or clipping Actions
54 *
55       LLEP=ABS(LEP)
56       IVFUN=1
57       LENGHT=4000
58       ICPOIN=JCGOBJ+1
59       IZPOIN=JCGOBJ+20000
60       IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)ICGP=ICGP+1
61 *
62       IF(IMOD.EQ.3)THEN
63          IST=2
64       ELSE IF(IMOD.EQ.4)THEN
65          IST=3
66          CALL CGSLIC(Q(ICPOIN),ABCD,LENGHT,Q(IZPOIN))
67 **SG
68       ELSE IF(IMOD.EQ.5)THEN
69          IST=3
70 *  Clip object
71          CALL GDCGCL(ISHAPE)
72 **SG
73       ELSE
74          WRITE(CHMAIL,10000)IMOD
75          CALL GMAIL(0,0)
76       ENDIF
77 *
78 **      IF(IVFUN.EQ.0)GOTO 999
79 *
80 ***SG
81 *      Inserting CG object in the Hidden Structure
82 *
83       IHPOIN=JCG+1
84       ICPOIN=JCGOBJ+1
85       ISPOIN=JCGOBJ+8000
86       IZPOIN=JCGOBJ+20000
87       IF(ISHAPE.EQ.29.OR.ISHAPE.EQ.99)ICPOIN=ISPOIN
88       IF(IMOD.EQ.4.OR.IMOD.EQ.5)ICPOIN=IZPOIN
89 *
90 *   Evaluate size of Hide Structure after all volumes
91 *   If it's too big, go back to GDRAW
92 *   If it's ok, build the Wire Structure
93 *
94       CALL CGHINS(Q(ICPOIN),Q(IHPOIN),ISHAPE)
95       IF(KCGST.EQ.-8)THEN
96          IF(NFIRST.EQ.1)THEN
97            NFIRST=0
98            WRITE(CHMAIL,10002)
99            CALL GMAIL(0,0)
100          ENDIF
101          NNN=NOBJ+1
102          IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)THEN
103            IF(ISG.EQ.NTVOL)NNN=NNN+LSTEP-1
104          ENDIF
105          IF(NNN.EQ.NCLAS2)THEN
106            KCGST=-9
107            NFIRST=1
108          ENDIF
109          GOTO 999
110       ENDIF
111 *
112 *      Building Up the Wiring structure.
113 *
114       ILCG=ILCG+1
115       IST=ILCG
116       IF(IST.GE.IQ(JCOUNT-1))THEN
117         WRITE(CHMAIL,10001)
118         CALL GMAIL(0,0)
119         GOTO 999
120       ENDIF
121       IF(LLEP.NE.1)THEN
122        IQ(IMCOUN+IST)=IQ(IMCOUN+IST-1)+NSHA
123       ENDIF
124       IQ(JCOUNT+IST)=IQ(JCOUNT+IST-1)+NTCUR
125       IF(IFCG.EQ.4.AND.ILCG.EQ.4)THEN
126         IQ(JCOUNT+4)=IQ(JCOUNT+4)-8000+1
127         IF(LLEP.NE.1)THEN
128          IQ(IMCOUN+4)=IQ(IMCOUN+4)-8000+1
129         ENDIF
130       ENDIF
131       IF(IFCG.EQ.3.AND.ILCG.EQ.3)THEN
132         IQ(JCOUNT+3)=IQ(JCOUNT+3)-4000+1
133         IF(LLEP.NE.1)THEN
134          IQ(IMCOUN+3)=IQ(IMCOUN+3)-4000+1
135         ENDIF
136       ENDIF
137       IF(LLEP.NE.1)THEN
138        MMPOIN=IMPOIN+IQ(IMCOUN+IST)
139       ENDIF
140       IWPOIN=JCG+IQ(JCOUNT+IST)
141       ICPOIN=JCGOBJ+1
142       IF(ISHAPE.EQ.29.OR.ISHAPE.EQ.99) ICPOIN=JCGOBJ+8000
143       IF(IMOD.EQ.4.OR.IMOD.EQ.5) ICPOIN=JCGOBJ+20000
144 *
145 *    Evaluate size of Wire structure after all volumes
146 *    If it's too big, go back to GDRAW
147 *    If it's ok, go on.
148 *
149       IF(LLEP.NE.1)THEN
150       CALL CGWIRE(Q(ICPOIN),NTRCG,-1,NWWS,Q(IWPOIN),ISHAPE,IQ(MMPOIN))
151       ELSE
152       CALL CGWIRE(Q(ICPOIN),NTRCG,-1,NWWS,Q(IWPOIN),ISHAPE,0)
153       ENDIF
154       IF(KCGST.EQ.-8)THEN
155          IF(NFIRST.EQ.1)THEN
156            NFIRST=0
157            WRITE(CHMAIL,10002)
158            CALL GMAIL(0,0)
159          ENDIF
160         NNN=NOBJ+1
161         IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)THEN
162            IF(ISG.EQ.NTVOL)NNN=NNN+LSTEP-1
163         ENDIF
164         IF(NNN.EQ.NCLAS2)THEN
165           KCGST=-10
166           NFIRST=1
167         ENDIF
168         NTCUR=0
169         GOTO 999
170       ENDIF
171       ITSTCU=Q(IWPOIN)
172       IF(LLEP.NE.1)NSHACU=IQ(MMPOIN)
173       IF(ITSTCU.NE.0)THEN
174        IOLDCU=ITSTCU
175        IF(LLEP.NE.1)IOLDNS=NSHACU
176       ENDIF
177       NTCUR=Q(IWPOIN)
178       IF(LLEP.NE.1)NSHA=IQ(MMPOIN)
179       NFILT=NFILT+NTCUR
180       IF(LLEP.NE.1)NTNEX=NTNEX+NSHA
181       IF(NTCUR.EQ.0)THEN
182         NTCUR=IOLDCU
183         IF(LLEP.NE.1)NSHA=IOLDNS
184         IF(IFCG.EQ.4.AND.ILCG.EQ.4)THEN
185           IQ(JCOUNT+4)=IQ(JCOUNT+4)-8000+1
186           IF(LLEP.NE.1)THEN
187            IQ(IMCOUN+4)=IQ(IMCOUN+4)-8000+1
188           ENDIF
189         ENDIF
190         IF(IFCG.EQ.3.AND.ILCG.EQ.3)THEN
191           IQ(JCOUNT+3)=IQ(JCOUNT+3)-4000+1
192           IF(LLEP.NE.1)THEN
193            IQ(IMCOUN+3)=IQ(IMCOUN+3)-4000+1
194           ENDIF
195         ENDIF
196         ILCG=ILCG-1
197         ICGP=ICGP-1
198       ENDIF
199 ***SG
200 10000    FORMAT('  IMOD  = ',I5,' is not defined  ')
201 10001    FORMAT(' *** GDCGHI *** : Please, increase size of',
202      +          ' the Zebra store; the drawing',
203      +          ' will not be completed.')
204 10002    FORMAT(' *** GDCGHI *** : The memory size is not enough;',
205      +          ' the program is going on evaluating the number of',
206      +          ' words missing.')
207 *
208   999 END