GEANT321/gtrak/gskpho.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:43  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 03/07/94  19.07.28  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSKPHO (IGK)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *                                                                *
  17 C.    *   Stores in stack JSTAK either the IGKth Cherenkov photon of   *
  18 C.    *   /GCKIN2/, or the NPHOT tracks when IGK is 0.                 *
  19 C.    *                                                                *
  20 C.    *   Called by : 'User'                                           *
  21 C.    *   Authors   : F.Carminati                                      *
  22 C.    *                                                                *
  23 C.    ******************************************************************
  24 C.
  25 #include "geant321/gcbank.inc"
  26 #include "geant321/gcjloc.inc"
  27 #include "geant321/gcking.inc"
  28 #include "geant321/gcnum.inc"
  29 #include "geant321/gcunit.inc"
  30 #include "geant321/gctrak.inc"
  31 #include "geant321/gcmzfo.inc"
  32 #include "geant321/gcstak.inc"
  33 #include "geant321/gckine.inc"
  34 *
  35       PARAMETER (NWPOLA=3)
  36 C.
  37 C.    ------------------------------------------------------------------
  38 C.
  39 *
  40 * *** Make sure the request is reasonable
  41       IF (NGPHOT.LE.0) GO TO 999
  42       IF (IGK.EQ.0) THEN
  43          N1 = 1
  44          N2 = NGPHOT
  45       ELSE
  46          IF (IGK.LT.0.OR.IGK.GT.NGPHOT) THEN
  47             WRITE(CHMAIL,10000) IGK, NGPHOT
  48 10000 FORMAT(' **** GSKPHO: ',I6,'th photon requested, ',
  49      + I6,' in stack')
  50             CALL GMAIL(0,0)
  51             GO TO 999
  52          ENDIF
  53          N1 = IGK
  54          N2 = IGK
  55       ENDIF
  56 *
  57 * *** Store photons in stack JSTAK
  58 *
  59 * *** Check that the bank is there and big enough
  60       IF (JSTAK.EQ.0) THEN
  61          NDBOOK = NTSTKP*NWSTAK +3
  62          NDPUSH = NTSTKS*NWSTAK
  63          CALL MZBOOK (IXCONS,JSTAK,JSTAK,1,'STAK', 1,1,NDBOOK, IOSTAK,3)
  64          IQ(JSTAK+2) = NTSTKP
  65       ENDIF
  66       IF(IQ(JSTAK-2).EQ.0) THEN
  67          CALL MZPUSH(IXCONS,JSTAK,1,0,'I')
  68       ENDIF
  69       IF(LQ(JSTAK-1).EQ.0) THEN
  70          CALL MZBOOK(IXCONS,JPOLAR,JSTAK,-1,'POLA',0,0,
  71      +               NTSTKP*NWPOLA,3,-1)
  72       ENDIF
  73       MISSNG=IQ(JSTAK+1)+N2-N1+1-IQ(JSTAK+2)
  74       IF (MISSNG.GT.0) THEN
  75          CALL MZPUSH (IXCONS, JSTAK, 0, MISSNG*NWSTAK+NDPUSH, 'I')
  76          IQ(JSTAK+2) = IQ(JSTAK+2) +NTSTKS+MISSNG
  77       ENDIF
  78       MSSPOL = IQ(JSTAK+1)+N2-N1+1-IQ(JPOLAR-1)/3
  79       IF(MSSPOL.GT.0) THEN
  80          CALL MZPUSH (IXCONS,JPOLAR,0,(NTSTKS+MSSPOL)*NWPOLA, 'I')
  81       ENDIF
  82 *
  83 * *** Now we can go
  84       DO 20  NN=N1,N2
  85          JST = JSTAK  +IQ(JSTAK+1)*NWSTAK +3
  86          JPO = JPOLAR +IQ(JSTAK+1)*NWPOLA
  87          IQ(JSTAK+1) = IQ(JSTAK+1) +1
  88          IF (IQ(JSTAK+3).EQ.0) IQ(JSTAK+3) = IQ(JSTAK+1)
  89          IF (IQ(JSTAK+1).GT.NSTMAX) NSTMAX = IQ(JSTAK+1)
  90 *
  91          IQ(JST+1) = -ITRA
  92          IQ(JST+2) = 50
  93          IQ(JST+3) = 0
  94          DO 10 I = 1,3
  95             Q(JST+3+I) = XPHOT(I  ,NN)
  96             Q(JST+6+I) = XPHOT(I+3,NN)*XPHOT(7,NN)
  97             Q(JPO+  I) = XPHOT(I+7,NN)
  98    10    CONTINUE
  99          Q(JST+10) = XPHOT(11,NN)
 100          Q(JST+11) = SAFETY
 101          Q(JST+12) = UPWGHT
 102 *
 103          NALIVE = NALIVE +1
 104    20 CONTINUE
 105 *                                                             END GSKPHO
 106   999 END