]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gdraw/geditv.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / geditv.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:29 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 GEDITV(IMENU)
13C.
14C. ******************************************************************
15C. * *
16C. * Edit volumes (only for interactive version) *
17C. * *
18C. * IMENU = option selected from menu (input) *
19C. * *
20C. * ==>Called by : GINC3 *
21C. * Author P.Zanarini ********* *
22C. * *
23C. ******************************************************************
24C.
25#include "geant321/gcbank.inc"
26#include "geant321/gcnum.inc"
27#include "geant321/gcunit.inc"
28#if defined(CERNLIB_USRJMP)
29#include "geant321/gcjump.inc"
30#endif
31 CHARACTER*4 CHNAME,CHNEW,NAMDIV,NAMMOT
32C.
33C. ------------------------------------------------------------------
34C.
35 CALL UCTOH(' ',IBLA,4,4)
36C
37 CALL KUPROC('Give volume NAME',CHNAME,NCH)
38 CALL UCTOH(CHNAME,NAME,4,NCH)
39 IVO=IUCOMP(NAME,IQ(JVOLUM+1),NVOLUM)
40 IF (IVO.LE.0) GO TO 999
41 JVO=LQ(JVOLUM-IVO)
42C
43C Get IVOMOT,NIN,JIN
44C
45 IF (IMENU.GE.4.AND.IMENU.LE.6) THEN
46 CALL KUPROI('Give copy NR',NR)
47 DO 20 IVOMOT=1,NVOLUM
48 JVOMOT=LQ(JVOLUM-IVOMOT)
49 NIN=Q(JVOMOT+3)
50 IF (NIN.LT.0) THEN
51 NIN=1
52 IDIV=1
53 ELSE
54 IDIV=0
55 ENDIF
56 DO 10 IN=1,NIN
57 JIN=LQ(JVOMOT-IN)
58 IVOSON=Q(JIN+2)
59 IF (IDIV.EQ.1) THEN
60 IF (IVOSON.EQ.IVO) GO TO 30
61 ELSE
62 NRSON=Q(JIN+3)
63 IF (IVOSON.EQ.IVO.AND.NRSON.EQ.NR) GO TO 30
64 ENDIF
65 10 CONTINUE
66 20 CONTINUE
67 GO TO 999
68 30 CONTINUE
69 ENDIF
70C
71C Get IVOMOT,JDIV
72C
73 IF (IMENU.GE.7.AND.IMENU.LE.8) THEN
74 DO 40 IVOMOT=1,NVOLUM
75 JVOMOT=LQ(JVOLUM-IVOMOT)
76 NIN=Q(JVOMOT+3)
77 IF (NIN.GE.0) GO TO 40
78 JDIV=LQ(JVOMOT-1)
79 IVOSON=Q(JDIV+2)
80 IF (IVOSON.EQ.IVO) GO TO 50
81 40 CONTINUE
82 GO TO 999
83 50 CONTINUE
84 ENDIF
85C
86 IF (IMENU.EQ.1) THEN
87C
88C Modify shape parameters PAR given by GSVOLU
89C
90 NP=Q(JVO+5)
91 DO 60 I=1,NP
92 PAR=Q(JVO+6+I)
93 WRITE (CHMAIL,1100) I,PAR
94 CALL GMAIL(0,0)
95 CALL KUPROR('Give new value',PAR)
96 Q(JVO+6+I)=PAR
97 60 CONTINUE
98
99C
100 ELSE IF (IMENU.EQ.2) THEN
101C
102C Modify NAME given by GSVOLU
103C
104 CALL KUPROC('Give new NAME',CHNEW,NCH)
105 NEWNAM=IBLA
106 CALL UCTOH(CHNEW,NEWNAM,4,NCH)
107 IQ(JVOLUM+IVO)=NEWNAM
108C
109 ELSE IF (IMENU.EQ.3) THEN
110C
111C Delete NAME given by GSVOLU
112C
113 70 CONTINUE
114 DO 90 IVOMOT=1,NVOLUM
115 JVOMOT=LQ(JVOLUM-IVOMOT)
116 NIN=Q(JVOMOT+3)
117 IF (NIN.LT.0) NIN=1
118 DO 80 IN=1,NIN
119 JIN=LQ(JVOMOT-IN)
120 IVOSON=Q(JIN+2)
121 NR=Q(JIN+3)
122 IF (IVOSON.EQ.IVO) GO TO 100
123 80 CONTINUE
124 90 CONTINUE
125 GO TO 110
126C
127 100 CONTINUE
128C
129C Unlink NAME,NR
130C
131#if !defined(CERNLIB_USRJMP)
132 CALL GUNLIV(IVO,NR,IVOMOT)
133#endif
134#if defined(CERNLIB_USRJMP)
135 CALL JUMPT3(JUNLIV,IVO,NR,IVOMOT)
136#endif
137 WRITE (CHMAIL,1000) NAME
138 CALL GMAIL(0,0)
139 1000 FORMAT (' *** GEDITV: ',A4,' UNLINKED')
140C
141C Try another link
142C
143 GO TO 70
144C
145 110 CONTINUE
146C
147C No more links; now delete NAME
148C
149 IQ(JVOLUM+IVO)=IBLA
150C
151 ELSE IF (IMENU.EQ.4) THEN
152C
153C Unlink NAME,NR given by GSPOS/GSDIV
154C
155#if !defined(CERNLIB_USRJMP)
156 CALL GUNLIV(IVO,NR,IVOMOT)
157#endif
158#if defined(CERNLIB_USRJMP)
159 CALL JUMPT3(JUNLIV,IVO,NR,IVOMOT)
160#endif
161C
162 ELSE IF (IMENU.EQ.5) THEN
163C
164C Modify X0,Y0,Z0 of NAME,NR given by GSPOS
165C
166 X0=Q(JIN+5)
167 Y0=Q(JIN+6)
168 Z0=Q(JIN+7)
169 CALL KUPROR('Give X0',X0)
170 CALL KUPROR('Give Y0',Y0)
171 CALL KUPROR('Give Z0',Z0)
172 Q(JIN+5)=X0
173 Q(JIN+6)=Y0
174 Q(JIN+7)=Z0
175C
176 ELSE IF (IMENU.EQ.6) THEN
177C
178C Modify IROT of NAME,NR given by GSPOS
179C
180 IROT=Q(JIN+4)
181 CALL KUPROI('Give IROT',IROT)
182 Q(JIN+4)=IROT
183C
184 ELSE IF (IMENU.EQ.7.OR.IMENU.EQ.8) THEN
185C
186 IF (IMENU.EQ.7) THEN
187C
188C Modify NDIV given by GSDIV
189C
190 NDIV=Q(JDIV+3)
191 CALL KUPROI('Give NDIV',NDIV)
192 Q(JDIV+3)=NDIV
193C
194 ELSE
195C
196C Modify IAXIS given by GSDIV
197C
198 IAXIS=Q(JDIV+1)
199 CALL KUPROI('Give IAXIS',IAXIS)
200 Q(JDIV+1)=IAXIS
201C
202 ENDIF
203C
204C Unlink and delete NAME
205C
206 Q(JVOMOT+3)=0
207 CALL MZDROP(IXCONS,LQ(JVOMOT-1),' ')
208 JV = LQ(JVOLUM-IVOMOT)
209 CALL MZPUSH(IXCONS,JV,-1,0,'I')
210 CALL UHTOC(IQ(JVOLUM+IVO),4,NAMDIV,4)
211 IQ(JVOLUM+IVO)=IBLA
212C
213C Redivide (division is now at NVOLUM-th position)
214C
215 CALL UHTOC(IQ(JVOLUM+IVOMOT),4,NAMMOT,4)
216 NDIV=Q(JDIV+3)
217 IAXIS=Q(JDIV+1)
218 CALL GSDVN(NAMDIV,NAMMOT,NDIV,IAXIS)
219C
220C Swap new division with old one (links + names)
221C
222 CALL DZSWAP(IXCONS,LQ(JVOLUM-NVOLUM),LQ(JVOLUM-IVO),' ')
223 IQ(JVOLUM+IVO)=IQ(JVOLUM+NVOLUM)
224 IQ(JVOLUM+NVOLUM)=IBLA
225 JVOMOT=LQ(JVOLUM-IVOMOT)
226 JDIV=LQ(JVOMOT-1)
227 Q(JDIV+2)=IVO
228 CALL UCTOH(NAMDIV,IQ(JVOLUM+IVO),4,4)
229C
230C Delete definitely old division
231C
232 CALL MZDROP(IXCONS,LQ(JVOLUM-NVOLUM),' ')
233 CALL MZPUSH(IXCONS,JVOLUM,-1,-1,'I')
234 NVOLUM=NVOLUM-1
235C
236 ENDIF
237C
238 1100 FORMAT(' PAR(',I2,') =',F10.3)
239 999 RETURN
240 END