GEANT321/giface/gpfis.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:15  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 GPFIS
  13 C
  14 C *** GENERATION OF PHOTO-FISSION AND PHOTO-ABSORBTION MECHANISMS ***
  15 C *** HMF 25-AUG-1989 RWTH AACHEN / NVE 11-MAY-1990 CERN GENEVA ***
  16 C
  17 C CALLED BY : GTGAMA
  18 C ORIGIN    : H.FESEFELDT (ROUTINE IPFISS)
  19 C
  20 #include "geant321/gcbank.inc"
  21 #include "geant321/gcjloc.inc"
  22 #include "geant321/gcmulo.inc"
  23 #include "geant321/gcphys.inc"
  24 #include "geant321/gcking.inc"
  25 #include "geant321/gckine.inc"
  26 #include "geant321/gconsp.inc"
  27 #include "geant321/gctrak.inc"
  28 #include "geant321/gsecti.inc"
  29 C
  30       DIMENSION RNDM(3),SPNEUT(10)
  31       LOGICAL CALFL
  32       SAVE SPNEUT,CALFL
  33 C
  34       DATA SPNEUT/10*0./
  35       DATA CALFL/.FALSE./
  36 C
  37       KCASE = NAMEC(23)
  38 C
  39       IF(IPFIS.NE.1) THEN
  40         DESTEP = DESTEP + GETOT
  41         GOTO 90
  42       ENDIF
  43 C
  44       ISTOP = 1
  45 C
  46 C     SELECT SUBPROCESS
  47 C
  48       STEPAB = (1.-GEKRAT)* Q(JPFIS+NEK1+IEKBIN)
  49      +       +     GEKRAT * Q(JPFIS+NEK1+IEKBIN+1)
  50       CALL GRNDM(RNDM,1)
  51       IF(RNDM(1).LT.STEPPF/STEPAB) GOTO 10
  52 C
  53 C     PHOTOABSORBTION
  54 C
  55       NGKINE    = 1
  56       TOFD(1)   = 0.0
  57       GKIN(5,1) = 13
  58       CALL GRNDM(RNDM,3)
  59       JPA       = LQ(JPART-13)
  60       GKIN(4,1) = Q(JPA+7) - 0.002*LOG(RNDM(1))
  61       COST      = -1.+2.*RNDM(2)
  62       SINT      = SQRT(1.-COST*COST)
  63       PHI       = TWOPI*RNDM(3)
  64       PPHMF     = GKIN(4,1)**2-Q(JPA+7)**2
  65       IF(PPHMF.LT.0.) PPHMF=0.
  66       PPHMF     = SQRT(PPHMF)
  67       GKIN(1,1) = PPHMF*SINT*SIN(PHI)
  68       GKIN(2,1) = PPHMF*SINT*COS(PHI)
  69       GKIN(3,1) = PPHMF*COST
  70       GPOS(1,1) = VECT(1)
  71       GPOS(2,1) = VECT(2)
  72       GPOS(3,1) = VECT(3)
  73 C
  74       GOTO 100
  75 C
  76 C     PHOTOFISSION
  77 C
  78    10 IF(CALFL) GOTO 20
  79       CALFL=.TRUE.
  80       XX        = 1.-0.5
  81       XXX       = SQRT(2.29*XX)
  82       SPNEUT(1) = EXP(-XX/0.965)*(EXP(XXX)-EXP(-XXX))/2.
  83       DO 11 I=2,10
  84       XX        = I*1.-0.5
  85       XXX       = SQRT(2.29*XX)
  86    11 SPNEUT(I) = SPNEUT(I-1)+EXP(-XX/0.965)*(EXP(XXX)-EXP(-XXX))/2.
  87       DO 12 I=1,10
  88    12 SPNEUT(I) = SPNEUT(I)/SPNEUT(10)
  89 C
  90 C
  91    20 NGKINE    = 1
  92       GKIN(1,1) = VECT(4)*VECT(7)
  93       GKIN(2,1) = VECT(5)*VECT(7)
  94       GKIN(3,1) = VECT(6)*VECT(7)
  95       GKIN(4,1) = GETOT
  96       GKIN(5,1) = 1
  97       TOFD(1)   = 0.0
  98       GPOS(1,1) = VECT(1)
  99       GPOS(2,1) = VECT(2)
 100       GPOS(3,1) = VECT(3)
 101 C
 102 C     NUMBER OF NEUTRONS AND PHOTONS
 103 C
 104       EKHMF     = GEKIN*1000.
 105       IF ( EKHMF.LT.1.) EKHMF=1.
 106       AVERN     = 2.569+0.559*LOG(EKHMF)
 107       AVERG     = 0.500+0.600*LOG(EKHMF)
 108       CALL NORMAL(RAN)
 109       NN        = IFIX(AVERN+RAN*1.23+0.5)
 110       CALL NORMAL(RAN)
 111       NG        = IFIX(AVERG+RAN*3.00+0.5)
 112       IF(NN.LT.1) NN=1
 113       IF(NG.LT.1) NG=1
 114 C
 115 C     DISTRIBUTE KINETIC ENERGY
 116 C
 117       JPA = LQ(JPART-13)
 118 C
 119       DO 25 I=1,NN
 120 C --- Protect against stack overflow ---
 121       IF (NGKINE .GE. MXGKIN) GO TO 31
 122          NGKINE = NGKINE+1
 123          CALL GRNDM(RNDM,1)
 124          DO 21 J=1,10
 125             IF(RNDM(1).LT.SPNEUT(J)) GOTO 22
 126    21    CONTINUE
 127          J=10
 128    22    CALL GRNDM(RNDM,1)
 129          GKIN(4,NGKINE) = (J-1)*1. + RNDM(1) + Q(JPA+7)*1000.
 130          GKIN(5,NGKINE) = 13
 131          TOFD(NGKINE)   = 0.0
 132          GPOS(1,NGKINE) = VECT(1)
 133          GPOS(2,NGKINE) = VECT(2)
 134          GPOS(3,NGKINE) = VECT(3)
 135    25 CONTINUE
 136 C
 137       DO 30 I=1,NG
 138 C --- Protect against stack overflow ---
 139       IF (NGKINE .GE. MXGKIN) GO TO 31
 140          NGKINE=NGKINE+1
 141          CALL GRNDM(RNDM,1)
 142          GKIN(4,NGKINE) = -0.87*LOG(RNDM(1))
 143          GKIN(5,NGKINE) = 1
 144          CALL GRNDM(RNDM,1)
 145          TOFD(NGKINE)   = -25.E-9*LOG(RNDM(1))
 146          GPOS(1,NGKINE) = VECT(1)
 147          GPOS(2,NGKINE) = VECT(2)
 148          GPOS(3,NGKINE) = VECT(3)
 149    30 CONTINUE
 150 C
 151 C --- GO BACK TO GEV UNITS ---
 152  31   CONTINUE
 153       DO 35 I=2,NGKINE
 154          GKIN(4,I)=GKIN(4,I)*1E-3
 155    35 CONTINUE
 156 C
 157 C     DISTRIBUTE DIRECTIONS ISOTROPICALLY IN LAB- SYSTEM
 158 C
 159       DO 40 I=2,NGKINE
 160          CALL GRNDM(RNDM,1)
 161          COST      = -1.+2.*RNDM(1)
 162          SINT      = SQRT(1.-COST*COST)
 163          CALL GRNDM(RNDM,1)
 164          PHI       = TWOPI*RNDM(1)
 165          IF (GKIN(5,I).LT.1.5) THEN
 166             PPHMF  = GKIN(4,I)
 167          ELSE
 168             PPHMF  = GKIN(4,I)**2 - Q(JPA+7)**2
 169             IF(PPHMF.LT.0.) PPHMF=0.
 170             PPHMF  = SQRT(PPHMF)
 171          ENDIF
 172          GKIN(1,I) = PPHMF*SINT*SIN(PHI)
 173          GKIN(2,I) = PPHMF*SINT*COS(PHI)
 174          GKIN(3,I) = PPHMF*COST
 175    40 CONTINUE
 176 C
 177       GOTO 100
 178 C
 179    90 ISTOP = 2
 180       IPART=1
 181       JPA = LQ(JPART-IPART)
 182       DO 95 J=1,5
 183          NAPART(J) = IQ(JPA+J)
 184    95 CONTINUE
 185       ITRTYP = Q(JPA+6)
 186       AMASS  = Q(JPA+7)
 187       CHARGE = Q(JPA+8)
 188       TLIFE  = Q(JPA+9)
 189       VECT(7)= 0.0
 190       GETOT  = 0.0
 191       GEKIN  = 0.0
 192 C
 193  100  CONTINUE
 194       END