This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gxint / gxpick.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:50  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.33  by  S.Giani
11 *-- Author :
12       SUBROUTINE GXPICK
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *      Geometry commands                                         *
17 C.    *                                                                *
18 C.    * Point to volume just drawn to pick up medium name, volume name *
19 C.    * etc. The first point points to the volume, the second point    *
20 C.    * gives the position of the character string which contains this *
21 C.    * information.                                                   *
22 C.    *                                                                *
23 C.    *       Authors:   S.Egli      **********                        *
24 C.    *                                                                *
25 C.    ******************************************************************
26 C.
27 #include "geant321/gconsp.inc"
28 #include "geant321/gcvolu.inc"
29 #include "geant321/gcdraw.inc"
30 #include "geant321/gcbank.inc"
31 #include "geant321/gcsets.inc"
32 #include "geant321/gctmed.inc"
33 #include "geant321/gcmate.inc"
34 #include "geant321/gcunit.inc"
35 *
36 * this COMMON filled in routine GDRAW !
37 *
38       COMMON/GCVHLP/NVLAST
39 *
40       DIMENSION XC(3),XYZ(3),XINVMA(3,3),VL(3),VM(3),VN(3)
41       DIMENSION XX(10),YY(10),RHELP(3)
42 *
43       CHARACTER*4 NAMV,CHIDTY
44       CHARACTER*20 NAMM
45       LOGICAL BTEST
46 *
47 * determine inverse matrix xinvma for current view parameters
48 *
49       PH = ABS(MOD(GPHI,360.))
50       THET = ABS(MOD(GTHETA,360.))
51       IF(THET.LE.180.)GO TO 10
52       PH = PH + 180.
53       THET = 360. - THET
54 *
55    10 ST = SIN(THET * DEGRAD)
56       CT = COS(THET * DEGRAD)
57       SP = SIN(PH * DEGRAD)
58       CP = COS(PH * DEGRAD)
59 *
60 *             VN is new nu axis
61 *
62       VN(1) = ST * CP
63       VN(2) = ST * SP
64       VN(3) = CT
65 *
66       IF(ABS(VN(2)).GT.0.99999) THEN
67 *
68 *             Special case when observer line of sight is along mu:
69 *             in this case one chooses arbitrarily the vertical axis of
70 *             plane of projection as the lambda axis and the horizontal
71 *             as the nu axis
72 *
73          VL(1) = 0.
74          VL(2) = 0.
75          VL(3) = 1.
76          VM(1) = 1.
77          VM(2) = 0.
78          VM(3) = 0.
79       ELSE
80 *
81          VM(1) = 0.
82          VM(2) = 1.
83          VM(3) = 0.
84 *
85 *             Define new lambda axis
86 *
87          CALL CROSS(VM,VN,VL)
88          CALL VUNIT(VL,VL,3)
89 *
90 *             Define new mu axis
91 *
92          CALL CROSS(VN,VL,VM)
93       ENDIF
94 *
95 *   now invert matrix defined by VL,VM,VN -> XINVMA
96 *
97       DO 20 I=1,3
98          XINVMA(1,I)=VL(I)
99          XINVMA(2,I)=VM(I)
100          XINVMA(3,I)=VN(I)
101    20 CONTINUE
102 *
103       CALL RINV(3,XINVMA,3,RHELP,IFAIL)
104       IF(IFAIL.NE.0)THEN
105          WRITE(CHMAIL,10100) IFAIL
106          CALL GMAIL(0,0)
107          GOTO 999
108       ENDIF
109 *
110 *   perspective projection ?
111 *
112       CALL UCTOH('PERS',IPERS,4,4)
113       IF(IPRJ.EQ.IPERS)THEN
114          WRITE(CHMAIL,10200)
115          CALL GMAIL(0,0)
116          GOTO 999
117       ENDIF
118 *
119 * pick up two points in user coordinates:
120 *
121    30 CALL IRQLC(1,1,ISTAT,NT,U0,V0)
122       IF(ISTAT.EQ.0)GOTO 999
123       CALL IRQLC(1,1,ISTAT,NT,U1,V1)
124       IF(ISTAT.EQ.0)GOTO 999
125 *
126 * transform (u0,v0) to coordinates in MARS system:
127 *  (inverse operation of what is done in routine GDFR3D)
128 *
129 *   take zoom parameters into account:
130 *
131       U01=(U0-GZUB-GZUC)/GZUA
132       V01=(V0-GZVB-GZVC)/GZVA
133 *
134 *   rotate and shift back
135 *
136       UU=+COSPSI*(U01-GU0)+SINPSI*(V01-GV0)
137       VV=-SINPSI*(U01-GU0)+COSPSI*(V01-GV0)
138       XYZ(1)=UU/GSCU
139       XYZ(2)=VV/GSCV
140       XYZ(3)=DCUT
141 *
142 *   apply xinvma
143 *
144       XC(1)=XINVMA(1,1)*XYZ(1)+XINVMA(1,2)*XYZ(2)+XINVMA(1,3)*XYZ(3)
145       XC(2)=XINVMA(2,1)*XYZ(1)+XINVMA(2,2)*XYZ(2)+XINVMA(2,3)*XYZ(3)
146       XC(3)=XINVMA(3,1)*XYZ(1)+XINVMA(3,2)*XYZ(2)+XINVMA(3,3)*XYZ(3)
147 *
148 *   build up GCVOLU structure with last drawn volume as
149 *   top of tree
150 *
151       NLEV=1
152       LNUM=0
153       CALL GLVOLU(NLEV,NVLAST,LNUM,IER)
154 *
155 *  determine medium
156 *
157       NUMED=0
158       CALL GMEDIA(XC,NUMED)
159 *
160       IF(NUMED.EQ.0)THEN
161          WRITE(CHMAIL,10300)
162          CALL GMAIL(0,0)
163          GOTO 30
164       ENDIF
165       JTM = LQ(JTMED- NUMED)
166       DO 40 I=1,5
167    40 NATMED(I)=IQ(JTM+I)
168       NMAT   = Q(JTM + 6)
169       ISVOL  = Q(JTM + 7)
170       IFIELD = Q(JTM + 8)
171       FIELDM = Q(JTM + 9)
172       TMAXFD = Q(JTM + 10)
173       STEMAX = Q(JTM + 11)
174       DEEMAX = Q(JTM + 12)
175       EPSIL  = Q(JTM + 13)
176       STMIN  = Q(JTM + 14)
177       CALL UHTOC(NAMES(NLEVEL),4,NAMV,4)
178       CALL UHTOC(NATMED,4,NAMM,20)
179       DO 50 I=1,20
180          IF(NAMM(I:I).EQ.'$')NAMM(I:I)=' '
181    50 CONTINUE
182       DO 60 I=20,1,-1
183          IF(NAMM(I:I).NE.' ')GOTO 70
184    60 CONTINUE
185    70 NJLAST=I
186 *
187 *  determine detector idtype
188 *
189       IF(JSET.GT.0)CALL GFINDS
190 *
191 * draw pointer and write volume name,medium
192 *
193       XX(1)=U0
194       YY(1)=V0
195       XX(2)=U1
196       YY(2)=V1
197       CALL IPL(2,XX,YY)
198 *
199 *  determine text alignment
200 *
201       PHI=ATAN2(V1-V0,U1-U0)*RADDEG
202       IF(ABS(PHI).LT.90.)THEN
203          IHOR=1
204       ELSE
205          IHOR=3
206       ENDIF
207       IF(PHI.GT.0.)THEN
208          IVER=5
209       ELSE
210          IVER=1
211       ENDIF
212       CALL ISTXAL(IHOR,IVER)
213 *
214       IF(.NOT.BTEST(IQ(LQ(JVOLUM-LVOLUM(1))),4))THEN
215          CALL ITX(U1,V1,NAMV//'"j# '//NAMM(1:NJLAST))
216       ELSE
217          WRITE(CHIDTY,10000)IDTYPE
218          CALL ITX(U1,V1,NAMV//'"j# '//NAMM(1:NJLAST)//','//CHIDTY)
219       ENDIF
220       GOTO 30
221 10000 FORMAT(I4)
222 10100 FORMAT(' GXPICK: Matrix inversion failed with ',I3,
223      +       '; abandoning')
224 10200 FORMAT(' GXPICK: perspective projection can not be handled')
225 10300 FORMAT(' GXPICK: point is outside volume')
226   999 END