GEANT321/gheisha/steeq.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:59  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE STEEQ(XXH,IPV)
  13 C
  14 C *** CORRECTIONS FOR SINGLE PARTICLE SPECTRA (SHOWER PARTICLES) ***
  15 C *** NVE 16-MAR-1988 CERN GENEVA
  16 C
  17 C ORIGIN : H.FESEFELDT (06-SEP-1985)
  18 C
  19 #include "geant321/mxgkgh.inc"
  20 #include "geant321/s_curpar.inc"
  21 #include "geant321/s_blank.inc"
  22 #include "geant321/s_result.inc"
  23 C
  24       DIMENSION ALEM(7),VAL0(7)
  25       DIMENSION RNDM(1)
  26 C**   DATA   EM/ 4.0 , 10.  , 15.  , 20.  ,  30. , 100. , 1000./
  27       DATA ALEM/ 1.40, 2.30 , 2.70 , 3.00 , 3.40 , 4.60 , 7.00 /
  28       DATA VAL0/ 0.00, 0.40 , 0.48 , 0.51 , 0.54 , 0.60 , 0.65 /
  29 C
  30       XXH=1.
  31 C
  32       IF ((IPART .NE. 7) .AND. (IPART .NE. 9)) GO TO 9999
  33       IF (ABS(IPA(IPV)) .NE. 8) GO TO 9999
  34       CALL GRNDM(RNDM,1)
  35       IF (RNDM(1) .GT. LOG(ATNO2)) GO TO 9999
  36       EKW=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
  37       ALEKW=LOG(EKW)
  38       IF (ALEKW .LE. ALEM(1)) GO TO 9999
  39 C
  40 C --- GET ENERGY BIN ---
  41       DO 1 I=2,7
  42       IF (ALEKW .LT. ALEM(I)) GO TO 2
  43  1    CONTINUE
  44       XXH=VAL0(7)
  45       GO TO 3
  46 C
  47 C *** USE LINEAR INTERPOLATION OR EXTRAPOLATION BY Y=RC*X+B ***
  48  2    CONTINUE
  49       I1=I-1
  50       I2=I
  51       DXNVE=ALEM(I2)-ALEM(I1)
  52       DYNVE=VAL0(I2)-VAL0(I1)
  53       RCNVE=DYNVE/DXNVE
  54       BNVE=VAL0(I1)-RCNVE*ALEM(I1)
  55       XXH=RCNVE*ALEKW+BNVE
  56 C
  57  3    CONTINUE
  58       XXH=1.-XXH
  59 C
  60  9999 CONTINUE
  61       RETURN
  62       END