GEANT321/gcons/gsckov.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:16  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 21/03/94  17.01.28  by  Rene Brun
  11 *-- Author :
  12       SUBROUTINE GSCKOV(ITMED, NPCKOV, PPCKOV, ABSCO, EFFIC, RINDEX)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    Stores the tables for UV photon tracking in medium ITMED    *
  17 C.    *    Please note that it is the user's responsability to         *
  18 C.    *    provide all the coefficients:                               *
  19 C.    *                                                                *
  20 C.    *                                                                *
  21 C.    *       ITMED       Tracking medium number                       *
  22 C.    *       NPCKOV      Number of bins of each table                 *
  23 C.    *       PPCKOV      Value of photon momentum (in GeV)            *
  24 C.    *       ABSCO       Absorbtion coefficents                       *
  25 C.    *                   dielectric: absorbtion length in cm          *
  26 C.    *                   metals    : absorbtion fraction (0<=x<=1)    *
  27 C.    *       EFFIC       Detection efficiency for UV photons          *
  28 C.    *       RINDEX      Refraction index (if=0 metal)                *
  29 C.    *                                                                *
  30 C.    *       Called by : <USER>                                       *
  31 C.    *                                                                *
  32 C.    *       Authors: F.Carminati, R.Jones  ************              *
  33 C.    *                                                                *
  34 C.    ******************************************************************
  35 C.
  36 #include "geant321/gcbank.inc"
  37 #include "geant321/gcnum.inc"
  38 #include "geant321/gcmzfo.inc"
  39 #include "geant321/gcunit.inc"
  40 #include "geant321/gcjloc.inc"
  41       DIMENSION PPCKOV(*), ABSCO(*), EFFIC(*), RINDEX(*)
  42 C.
  43 C.    ------------------------------------------------------------------
  44 C.
  45       JTM = 0
  46       IF(ITMED.GT.0) THEN
  47          IF(JTMED.GT.0) THEN
  48             IF(IQ(JTMED-2).GE.ITMED) THEN
  49                JTM = LQ(JTMED-ITMED)
  50             ENDIF
  51          ENDIF
  52       ENDIF
  53       IF(JTM.LE.0) THEN
  54          WRITE(CHMAIL,10000)
  55 10000   FORMAT(' **** GSCKOV Tracking medium ',I10,' not defined')
  56          CALL GMAIL(0,0)
  57          GO TO 999
  58       ENDIF
  59       IF(IQ(JTM-2).LT.3) THEN
  60          CALL MZPUSH(IXSTOR,JTM,3-IQ(JTM-2),0,' ')
  61       ENDIF
  62       CALL MZBOOK(IXCONS,JTCKOV,JTM,-3,'CKOV',4,4,NPCKOV+1,3,-1)
  63       CALL MZBOOK(IXCONS,JABSCO,JTCKOV,-1,'ABSC',0,0,NPCKOV,3,-1)
  64       CALL MZBOOK(IXCONS,JEFFIC,JTCKOV,-2,'EFFI',0,0,NPCKOV,3,-1)
  65       IF(RINDEX(1).GE.1.) THEN
  66          CALL MZBOOK(IXCONS,JINDEX,JTCKOV,-3,'RIND',0,0,NPCKOV,3,-1)
  67          CALL MZBOOK(IXCONS,JCURIN,JTCKOV,-4,'ABCU',0,0,NPCKOV,3,-1)
  68       ENDIF
  69       Q(JTCKOV+1)=NPCKOV
  70       DO 10 J=1, NPCKOV
  71          Q(JTCKOV+1+J) = PPCKOV(J)
  72          Q(JABSCO+  J) = MAX(1E-10,ABSCO(J))
  73          Q(JEFFIC+  J) = EFFIC(J)
  74          IF(RINDEX(1).GE.1.) THEN
  75             Q(JINDEX+ J) = RINDEX(J)
  76             IF(J.GT.1) THEN
  77                Q(JCURIN+J)=0.5*((1/RINDEX(J-1)**2)+(1./RINDEX(J)**2))
  78                Q(JCURIN+J)=Q(JCURIN+J-1)+(PPCKOV(J)-PPCKOV(J-1))*
  79      +                     Q(JCURIN+J)
  80             ELSE
  81                Q(JCURIN+J)=0.
  82             ENDIF
  83          ENDIF
  84    10 CONTINUE
  85 *
  86   999 END