* * $Id$ * * $Log$ * Revision 1.1.1.1 1995/10/24 10:21:59 cernlib * Geant * * #include "geant321/pilot.h" *CMZ : 3.21/04 23/02/95 14.46.01 by S.Giani *-- Author : SUBROUTINE SECLF1(FSE,IFSE,EX,U,E) C THIS ROUTINE SAMPLES AN EXIT ENERGY FROM C A TABULATED DISTRIBUTION #include "geant321/minput.inc" DIMENSION FSE(*),IFSE(*) SAVE C=0. IP=1 NRE=IFSE(IP) NE=IFSE(IP+1) IP=IP+2*NRE+1 C FIND THE TWO INCIDENT ENERGY DISTRIBUTIONS THAT BOUND E C INCIDENT ENERGY IS BELOW THE FIRST INCIDENT ENERGY GIVEN C USE THE FIRST DISTRIBUTION IP=IP+1 IE=1 E1=FSE(IP) IP1=IP IF(E.GT.E1)GO TO 10 IPR=IP+1 NR=IFSE(IPR) NP=IFSE(IPR+1) GO TO 50 10 IP=IP+1 IPR1=IP NP1=IFSE(IP+1) IP=IP+2*IFSE(IPR1)+1 IP=IP+2*NP1 20 IE=IE+1 IP=IP+1 C INCIDENT ENERGY IS ABOVE THE LAST INCIDENT ENERGY GIVEN C USE THE LAST DISTRIBUTION IF(IE.GT.NE)GO TO 40 E2=FSE(IP) IF(E.LE.E2)GO TO 30 E1=E2 IP1=IP IP=IP+1 IPR1=IP NP1=IFSE(IP+1) IP=IP+2*IFSE(IPR1)+1 IP=IP+2*NP1 GO TO 20 30 IP2=IP IP=IP+1 IPR2=IP NP2=IFSE(IP+1) IP=IP+2*IFSE(IPR2)+1 C DETERMINE THE INTERPOLATING SCHEME CALL INTSCH(IFSE,IE,IS,NRE) C SELECT THE DISTRIBUTION TO SAMPLE FROM R=FLTRNF(0) C INTERPOLATION SCHEMES OF 1 (CONSTANT) OR 2 (LINEAR) ALLOWED IF(IS.GT.2)GO TO 110 PROB=(E2-E)/(E2-E1) IF(IS.EQ.1)PROB=1.0 IF(R.LE.PROB)GO TO 40 C SELECT FROM THE SECOND DISTRIBUTION NP=NP2 IP=IP2 IPR=IPR2 GO TO 50 C SELECT FROM THE FIRST DISTRIBUTION C OR FROM THE LAST INCIDENT ENERGY 40 NP=NP1 IP=IP1 IPR=IPR1 C SELECT THE EXIT ENERGY FROM THE TABULATED DISTRIBUTION 50 CONTINUE ITRY = 0 60 CONTINUE PROB=0. R=FLTRNF(0) NR=2*IFSE(IPR)+1 DO 90 I=1,NP CALL INTSCH(IFSE(IPR),NP,IS,IFSE(IPR)) N=IP+NR+1+2*I PROB1=PROB IF(I.EQ.1)GO TO 90 IF(IS.EQ.1)GO TO 70 IF(IS.GT.2)GO TO 110 PROB=PROB+(FSE(N)+FSE(N-2))*(FSE(N-1)-FSE(N-3))/2. GO TO 80 70 PROB=PROB+FSE(N-2)*(FSE(N-1)-FSE(N-3)) 80 IF(R.LE.PROB)GO TO 100 90 CONTINUE ITRY = ITRY + 1 IF(ITRY.LT.5) GOTO 60 IF(R.LT..998)GO TO 120 100 EX=FSE(N-3)+(R-PROB1)*(FSE(N-1)-FSE(N-3))/(PROB-PROB1) RETURN 110 WRITE(IOUT,10000)IS 10000 FORMAT(' MICAP: INTERPOLATION SCHEME=',I3,' IN SECLF1') GOTO 130 120 WRITE(IOUT,10100)R,PROB 10100 FORMAT(' MICAP: EXIT ENERGY NOT SELECTED IN SECLF1',1P2E13.5) 130 WRITE(6,*) ' CALOR: ERROR in SECLF1 =====> STOP ' STOP END