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