SUBROUTINE MUPRPR C----------------------------------------------------------------------- C MU(ON) P(AI)R PR(ODUCTION) C C TREATES MUON PAIR PRODUCTION (WITHOUT POLARISATION EFFECTS) C IN ANALOGY WITH SUBROUTINE GPAIRM FROM GEANT WRITTEN BY L. URBAN C EXPLANATIONS SEE CERN PROGRM LIBRARY LONG WRITEUP W5013 C THIS SUBROUTINE IS CALLED FROM MUTRAC C C DESIGN : D. HECK IK3 FZK KARLSRUHE C----------------------------------------------------------------------- IMPLICIT NONE *KEEP,CONST. COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER *KEEP,ELABCT. COMMON /ELABCT/ ELCUT DOUBLE PRECISION ELCUT(4) *KEEP,GENER. COMMON /GENER/ GEN,ALEVEL DOUBLE PRECISION GEN,ALEVEL *KEEP,MUPART. COMMON /MUPART/ AMUPAR,BCUT,CMUON,FMUBRM,FMUORG DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11) LOGICAL FMUBRM,FMUORG *KEEP,PAM. COMMON /PAM/ PAMA,SIGNUM DOUBLE PRECISION PAMA(6000),SIGNUM(6000) *KEEP,PARPAR. COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C, * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14), * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH INTEGER ITYPE,LEVL *KEEP,PARPAE. DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE), * (CURPAR(4), PHI ), (CURPAR(5), H ), * (CURPAR(6), T ), (CURPAR(7), X ), * (CURPAR(8), Y ), (CURPAR(9), CHI ), * (CURPAR(10),BETA), (CURPAR(11),GCM ), * (CURPAR(12),ECM ) *KEEP,POLAR. COMMON /POLAR/ POLART,POLARF DOUBLE PRECISION POLART,POLARF *KEEP,RANDPA. COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR DOUBLE PRECISION FAC,U1,U2 REAL RD(3000) INTEGER ISEED(103,10),NSEQ LOGICAL KNOR *KEEP,REST. COMMON /REST/ CONTNE,TAR,LT DOUBLE PRECISION CONTNE(3),TAR INTEGER LT *KEEP,RUNPAR. COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB, * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN, * MONIOU,MDEBUG,NUCNUC, * CETAPE, * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, * N1STTR,MDBASE, * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, * FIX1I,FMUADD,FNKG,FPRINT,FDBASE * ,GHEISH,GHESIG COMMON /RUNPAC/ DSN,HOST,USER DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB REAL STEPFC INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC, * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, * N1STTR,MDBASE INTEGER CETAPE CHARACTER*79 DSN CHARACTER*20 HOST,USER LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, * FIX1I,FMUADD,FNKG,FPRINT,FDBASE * ,GHEISH,GHESIG *KEND. DOUBLE PRECISION AA,ALE,ALFA,AL10T,A1,A1R,B,BETA1,CC,C1,C2, * COSTH3,COSTH4,EKIN,EMUON,ENEG,EPOS,EPP, * PHI3,PPOS,R0,R0MAX,SCREJ,SINTH3, * TPOS,V,VC,VMAX,VMIN,V0,Z INTEGER I DATA AL10T/9.212D0/ C----------------------------------------------------------------------- IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9) 444 FORMAT(' MUPRPR: CURPAR=',1P,9E10.3) C COPY COORDINATES TO SECPAR DO 11 I = 5,8 SECPAR(I) = CURPAR(I) 11 CONTINUE SECPAR( 9) = GEN C SET MATERIAL CONSTANTS CMUON(.) ACCORDING TO C TARGET INDEX LT (1=N, 2=O, 3=AR) WHICH HAS BEEN SET IN BOX2 IF ( LT .EQ. 1 ) THEN Z = 7.D0 ELSEIF ( LT .EQ. 2 ) THEN Z = 8.D0 ELSE Z = 18.D0 ENDIF C TOTAL AND KINETIC ENERGY OF MUON EMUON = PAMA(5) * GAMMA EKIN = EMUON - PAMA(5) IF ( EKIN .LE. BCUT ) GOTO 900 C VMIN = 4.D0 * PAMA(2) / EMUON VMAX = 1.D0 - CMUON(10) * Z**OB3 / EMUON IF ( VMAX .LE. VMIN ) GOTO 900 VC = BCUT / EMUON ALE = LOG(EMUON) ALFA = 1.D0 + ALE/AL10T V0 = 0.18D0 * (4.D0 + ALE/AL10T) * ALFA * (ALFA*VMIN)**TB3 BETA1 = 0.1D0 * (1.D0 + 3.D0 * ALE/AL10T) B = 0.9D0 / (1.D0 + 0.4D0*ALE + 0.022D0*ALE**2) AA = 1.D0 + 2.D0 * B * LOG(VC/V0) IF ( AA .LE. 1.D0 ) AA = 1.05D0 A1 = 1.D0 - AA CC = EXP(-0.25D0*A1*A1/B) A1R = 1.D0 / A1 C1 = VMAX**A1 C2 = VC**A1 C SAMPLE ENERGY FRACTION V AND RO 50 CALL RMMAR(RD,2,1) V = ( RD(1)*C1 + (1.-RD(1))*C2 )**A1R IF ( V .LE. VMIN ) GOTO 50 IF ( V .LT. V0 ) THEN SCREJ = CC * ( (V-VMIN)/(V0-VMIN) )**BETA * (V0/V)**A1 ELSE SCREJ = CC * (V0/V)**( A1 + B*LOG(V/V0) ) ENDIF IF ( RD(2) .GT. SCREJ ) GOTO 50 R0MAX = SCREJ * ( 1.D0 - 6.D0 *PAMA(5)/( EMUON**2 * (1.D0-V) ) ) CALL RMMAR(RD,2,1) R0 = R0MAX * (2.*RD(1)-1.) C ENERGIES EPP = V * EMUON EPOS = 0.5D0 * EPP * (1.D0 + R0) ENEG = EPP - EPOS C ANGLES COSTH3 = COS( PAMA(5)/EMUON ) PHI3 = PI2 * RD(2) C POSITRON IF ( EPOS .GT. BCUT+PAMA(3) ) THEN CALL ADDANG( COSTHE,PHI, COSTH3,PHI3, SECPAR(3),SECPAR(4) ) IF ( SECPAR(3) .GT. C(29) ) THEN SECPAR( 1) = 2.D0 SECPAR( 2) = EPOS/PAMA(2) SECPAR(10) = H CALL TSTACK ENDIF ENDIF C ELECTRON IF ( ENEG .GT. BCUT+PAMA(3) ) THEN CALL ADDANG( COSTHE,PHI, COSTH3,-PHI3, SECPAR(3),SECPAR(4) ) IF ( SECPAR(3) .GT. C(29) ) THEN SECPAR( 1) = 3.D0 SECPAR( 2) = ENEG/PAMA(2) SECPAR(10) = H CALL TSTACK ENDIF ENDIF C REDUCE ENERGY OF MUON 60 CONTINUE GAMMA = (EMUON - EPP)/ PAMA(5) 900 CONTINUE C WRITE MUON TO STACK SECPAR( 1) = CURPAR(1) SECPAR( 2) = GAMMA SECPAR( 3) = CURPAR(3) SECPAR( 4) = CURPAR(4) SECPAR(10) = ALEVEL CALL TSTACK RETURN END