GEANT321/gdraw/gdstep.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:30  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GDSTEP
  13 *
  14 ************************************************************************
  15 *                                                                      *
  16 *       RAY-TRACING                                                    *
  17 *       Light processing at the end of each step                       *
  18 *                                                                      *
  19 *       Author: S.Giani.                                               *
  20 *                                                                      *
  21 ************************************************************************
  22 *
  23 #include "geant321/gctmed.inc"
  24 #include "geant321/gcking.inc"
  25 #include "geant321/gcflag.inc"
  26 #include "geant321/gctrak.inc"
  27 ********************************************************************************
  28 #include "geant321/gcbank.inc"
  29 #include "geant321/gcvdma.inc"
  30 #include "geant321/gcpixe.inc"
  31 #include "geant321/gcrayt.inc"
  32
  33       DIMENSION PROTU(1),PROTV(1)
  34       DIMENSION OUT(10)
  35       DIMENSION CKDIFF(8),CKSPRE(8),NEXPO(8)
  36       DATA CKDIFF/0.40,0.80,0.50,0.50,0.25,0.25,0.00,0.00/
  37       DATA CKSPRE/0.00,0.00,0.50,0.50,0.75,0.75,1.00,1.00/
  38       DATA NEXPO/0,0,2,7,2,7,1,10/
  39 *
  40 *  LSTY keys:
  41 *   0=darkmatt; 1=brightmatt; 2=plastic; 3=ceramic; 4=roughmetal;
  42 *   5=shinymetal; 6=glass; 7=mirror.
  43 *
  44       SAVE MYMED,APROSH,MYOMED,SPONOR,XYZMOD
  45 ********************************************************************************
  46       BOFLAG=0.
  47       IF(ISSEEN.EQ.1.OR.ISSEEN.EQ.-2)THEN
  48       IF(INWVOL.EQ.1.OR.(INWVOL.EQ.3.AND.IOMBRA.EQ.9))THEN
  49         BOFLAG=1.
  50                    PROTU(1)=UUU
  51                    PROTV(1)=VVV
  52        IF(IOMBRA.NE.9)THEN
  53        IF(NOFLAG.EQ.0)THEN
  54          out(1)=veccos(1)*vect(4)+veccos(2)*vect(5)+veccos(3)*vect(6)
  55          out(2)=veccos(1)
  56          out(3)=veccos(2)
  57          out(4)=veccos(3)
  58          OBSNOR=ABS(OUT(1))
  59          APROSC=ABS(OUT(1))*CKDIFF(ISLSTY+1)
  60          if(aprosc.lt.0.)then
  61             print *,'warning: aprosc.lt.0'
  62          endif
  63          IF(ISLSTY.NE.0.AND.ISLSTY.NE.1)THEN
  64            BPROSC=(2.*(OUT(1)**2))-1.
  65            IF(BPROSC.GT.0.)THEN
  66              BPROSC=CKSPRE(ISLSTY+1)*(BPROSC**NEXPO(ISLSTY+1))
  67            ELSE
  68              BPROSC=0.
  69            ENDIF
  70            APROSC=(APROSC+BPROSC)
  71          ENDIF
  72        ELSE
  73          OBSNOR=APFLAG
  74          APROSC=APFLAG*CKDIFF(ISLSTY+1)
  75          if(aprosc.lt.0.)then
  76            print *,'warning: aprosc.lt.0',aprosc
  77          endif
  78          IF(ISLSTY.NE.0.AND.ISLSTY.NE.1)THEN
  79            BPROSC=(2.*(APFLAG**2))-1.
  80            IF(BPROSC.GT.0.)THEN
  81              BPROSC=CKSPRE(ISLSTY+1)*(BPROSC**NEXPO(ISLSTY+1))
  82            ELSE
  83              BPROSC=0.
  84            ENDIF
  85            APROSC=(APROSC+BPROSC)
  86          ENDIF
  87        ENDIF
  88        ENDIF
  89        IF(IOMBRA.EQ.10)THEN
  90          XYZMOD=1./SQRT((XLPOS-VECT(1))**2+(YLPOS-VECT(2))**2+
  91      +                  (ZLPOS-VECT(3))**2)
  92          IF(NOFLAG.EQ.0)THEN
  93 *         call ggperp(vect,veccos,ierr)
  94 *         if(ierr.eq.1)then
  95 *           veccos(1)=1.
  96 *           veccos(2)=0.
  97 *           veccos(3)=0.
  98 *         endif
  99          out(1)=veccos(1)*vect(4)+veccos(2)*vect(5)+veccos(3)*vect(6)
 100          out(2)=veccos(1)
 101          out(3)=veccos(2)
 102          out(4)=veccos(3)
 103           XLDIR=(XLPOS-VECT(1))*XYZMOD
 104           YLDIR=(YLPOS-VECT(2))*XYZMOD
 105           ZLDIR=(ZLPOS-VECT(3))*XYZMOD
 106           APROSH=((OUT(2)*XLDIR)+(OUT(3)*YLDIR)+(OUT(4)*ZLDIR))*
 107      +    CKDIFF(ISLSTY+1)
 108           SPONOR=APROSH/CKDIFF(ISLSTY+1)
 109           IF(ISLSTY.NE.0.AND.ISLSTY.NE.1)THEN
 110           IF(SPONOR.GT.0.)THEN
 111             B1=OUT(4)*YLDIR-OUT(3)*ZLDIR
 112             B2=OUT(2)*ZLDIR-OUT(4)*XLDIR
 113             B3=OUT(3)*XLDIR-OUT(2)*YLDIR
 114             VRX=OUT(4)*B2-OUT(3)*B3+OUT(2)*SPONOR
 115             VRY=OUT(2)*B3-OUT(4)*B1+OUT(3)*SPONOR
 116             VRZ=OUT(3)*B1-OUT(2)*B2+OUT(4)*SPONOR
 117             COSB1=VRX*XCOSXS+VRY*YCOSYS+VRZ*ZCOSZS
 118             IF(COSB1.GT.0.)THEN
 119               BPROSH=CKSPRE(ISLSTY+1)*(COSB1**NEXPO(ISLSTY+1))
 120 *              print *,COSB1**ISLSTY
 121             ELSE
 122               BPROSH=0.
 123             ENDIF
 124             APROSH=(APROSH+BPROSH)
 125           ENDIF
 126           ENDIF
 127          ELSE
 128           SPONOR=APFLAH
 129           APROSH=APFLAH*CKDIFF(ISLSTY+1)
 130           IF(ISLSTY.NE.0.AND.ISLSTY.NE.1)THEN
 131           IF(SPONOR.GT.0.)THEN
 132             IF(IXYFLA.EQ.1)THEN
 133               OUT(2)=CCXX(2)
 134               OUT(3)=CCXX(3)
 135               OUT(4)=CCXX(4)
 136             ELSEIF(IXYFLA.EQ.2)THEN
 137               OUT(2)=CCYY(2)
 138               OUT(3)=CCYY(3)
 139               OUT(4)=CCYY(4)
 140             ELSEIF(IXYFLA.EQ.3)THEN
 141               OUT(2)=CCZZ(2)
 142               OUT(3)=CCZZ(3)
 143               OUT(4)=CCZZ(4)
 144             ELSE
 145               print *,'problem for ixyfla'
 146             ENDIF
 147             B1=OUT(4)*YLDIR-OUT(3)*ZLDIR
 148             B2=OUT(2)*ZLDIR-OUT(4)*XLDIR
 149             B3=OUT(3)*XLDIR-OUT(2)*YLDIR
 150             VRX=OUT(4)*B2-OUT(3)*B3+OUT(2)*SPONOR
 151             VRY=OUT(2)*B3-OUT(4)*B1+OUT(3)*SPONOR
 152             VRZ=OUT(3)*B1-OUT(2)*B2+OUT(4)*SPONOR
 153             COSB1=VRX*XCOSXS+VRY*YCOSYS+VRZ*ZCOSZS
 154             IF(COSB1.GT.0.)THEN
 155               BPROSH=CKSPRE(ISLSTY+1)*(COSB1**NEXPO(ISLSTY+1))
 156 *              print *,COSB1**ISLSTY
 157             ELSE
 158               BPROSH=0.
 159             ENDIF
 160             APROSH=(APROSH+BPROSH)
 161           ENDIF
 162           ENDIF
 163          ENDIF
 164        ENDIF
 165        SAVMED=NUMED
 166        IF(IOMBRA.EQ.10)MYOMED=ISCOLO
 167        IF(IOMBRA.NE.9)THEN
 168            CALL GDLUMI(ISCOLO,APROSC)
 169        ENDIF
 170        IF(IOMBRA.NE.9.AND.IOMBRA.NE.10)THEN
 171         IF(IMAP.EQ.1)THEN
 172          JON=1
 173         ELSE
 174 **         IF(ISWIT(9).NE.54321)THEN
 175           CALL IPM(1,PROTU,PROTV)
 176 **         ELSE
 177 **          CALL IXPIXEL(IXXX,IYYY,ICOLOR)
 178 **         ENDIF
 179         ENDIF
 180        ELSEIF(IOMBRA.EQ.10)THEN
 181          MYMED=ISCOLO
 182        ELSEIF(IOMBRA.EQ.9)THEN
 183          IF((INWVOL.EQ.3.AND.SPONOR.GT.0.).OR.(INWVOL.EQ.1.AND.
 184      +       SPONOR.GT.0..AND.SLENG.GE.(1./XYZMOD)))THEN
 185            CALL GDLUMI(MYOMED,APROSH)
 186            SINTEN=INTEN*.1
 187            FINMED=((1.-SINTEN)*MYMED)+(SINTEN*MYOMED)
 188            MEDFIN=FINMED
 189            IF((FINMED-MEDFIN).GT..5)MEDFIN=MEDFIN+1
 190            CALL ISPMCI(MEDFIN)
 191            CALL IPM(1,PROTU,PROTV)
 192            IF(INWVOL.EQ.3.AND.SPONOR.GT.0.)IOMBRA=10
 193          ELSE
 194           SINTEN=INTEN*.1
 195            IF(MYOMED.EQ.2)THEN
 196             MYOMED=17
 197            ELSEIF(MYOMED.EQ.3)THEN
 198             MYOMED=67
 199            ELSEIF(MYOMED.EQ.4)THEN
 200             MYOMED=117
 201            ELSEIF(MYOMED.EQ.5)THEN
 202             MYOMED=42
 203            ELSEIF(MYOMED.EQ.6)THEN
 204             MYOMED=142
 205            ELSEIF(MYOMED.EQ.7)THEN
 206             MYOMED=92
 207            ENDIF
 208            FINMED=((1.-SINTEN)*MYMED)+(SINTEN*MYOMED)
 209            MEDFIN=FINMED
 210            IF((FINMED-MEDFIN).GT..5)MEDFIN=MEDFIN+1
 211            CALL ISPMCI(MEDFIN)
 212            CALL IPM(1,PROTU,PROTV)
 213            IF(INWVOL.EQ.3.AND.SPONOR.LE.0.)IOMBRA=10
 214          ENDIF
 215        ENDIF
 216        NUMED=SAVMED
 217       ENDIF
 218       ENDIF
 219 ********************************************************************************
 220 *
 221       END