| 1 | REAL FUNCTION GPRSGM(Z,E)
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C G(EANT) P(AI)R S(I)GM(A)
|
|---|
| 5 | C CALCULATES MUON PAIR PRODUCTION CROSS SECTIONS
|
|---|
| 6 | C
|
|---|
| 7 | C THIS SUBROUTINE IS TAKEN FROM GEANT321 PACKAGE (WITH MODIFICATIONS)
|
|---|
| 8 | C CALCULATES CROSS-SECTION IN CURRENT MATERIAL FOR DISCRETE(HARD) MUON
|
|---|
| 9 | C PAIR PRODUCTION. (SIG IN BARN/ATOM)
|
|---|
| 10 | C FOR A DESCRIPTION SEE: CERN PROGRAM LIBRARY LONG WRITEUP W5013 (1993)
|
|---|
| 11 | C THIS SUBROUTINE IS CALLED FROM BOX2
|
|---|
| 12 | C ARGUMENTS:
|
|---|
| 13 | C Z (R4) = ATOMIC NUMBER OF PENETRATET MATERIAL
|
|---|
| 14 | C E (R4) = TOTAL ENERGY OF MUON
|
|---|
| 15 | C
|
|---|
| 16 | C AUTHOR : L.URBAN
|
|---|
| 17 | C MODIFIED: D. HECK IK3 FZK KARLSRUHE
|
|---|
| 18 | C-----------------------------------------------------------------------
|
|---|
| 19 |
|
|---|
| 20 | IMPLICIT NONE
|
|---|
| 21 | *KEEP,CONST.
|
|---|
| 22 | COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
|
|---|
| 23 | DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
|
|---|
| 24 | *KEEP,MUPART.
|
|---|
| 25 | COMMON /MUPART/ AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
|
|---|
| 26 | DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
|
|---|
| 27 | LOGICAL FMUBRM,FMUORG
|
|---|
| 28 | *KEEP,PAM.
|
|---|
| 29 | COMMON /PAM/ PAMA,SIGNUM
|
|---|
| 30 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
|---|
| 31 | *KEEP,RUNPAR.
|
|---|
| 32 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 33 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 34 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 35 | * CETAPE,
|
|---|
| 36 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 37 | * N1STTR,MDBASE,
|
|---|
| 38 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 39 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 40 | * ,GHEISH,GHESIG
|
|---|
| 41 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 42 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 43 | REAL STEPFC
|
|---|
| 44 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 45 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 46 | * N1STTR,MDBASE
|
|---|
| 47 | INTEGER CETAPE
|
|---|
| 48 | CHARACTER*79 DSN
|
|---|
| 49 | CHARACTER*20 HOST,USER
|
|---|
| 50 |
|
|---|
| 51 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 52 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 53 | * ,GHEISH,GHESIG
|
|---|
| 54 | *KEND.
|
|---|
| 55 |
|
|---|
| 56 | REAL C(100),C1(60),C2(40),AKSI,ALFA,E,ECMAX,ECMIN,FAC,GAM,
|
|---|
| 57 | * S,SS,VS,X,XX,Y,YY,Z
|
|---|
| 58 | INTEGER I,J,K
|
|---|
| 59 | EQUIVALENCE (C(1),C1(1)),(C(61),C2(1))
|
|---|
| 60 | SAVE C
|
|---|
| 61 | DATA AKSI/1.16/,ALFA/3.46/,GAM/0.06/,VS/0.019/
|
|---|
| 62 | DATA ECMIN/2.044E-3/
|
|---|
| 63 | DATA C1/0.230181E-08,-0.280842E-08, 0.137525E-08,-0.156503E-09
|
|---|
| 64 | + , 0.728088E-11,-0.122631E-12, 0.133014E-08,-0.160591E-09
|
|---|
| 65 | + ,-0.390814E-09, 0.314492E-10, 0.251296E-12,-0.574223E-13
|
|---|
| 66 | + , 0.604923E-09,-0.560766E-09, 0.660253E-09,-0.103474E-09
|
|---|
| 67 | + , 0.621338E-11,-0.135273E-12, 0.103739E-09, 0.710290E-09
|
|---|
| 68 | + ,-0.544755E-10,-0.211241E-11, 0.286443E-12,-0.644602E-14
|
|---|
| 69 | + , 0.332492E-09,-0.484785E-10, 0.126921E-10,-0.165217E-11
|
|---|
| 70 | + , 0.845273E-13,-0.143180E-14,-0.112267E-13, 0.113308E-11
|
|---|
| 71 | + , 0.292577E-12,-0.733441E-13, 0.475747E-14,-0.976279E-16
|
|---|
| 72 | + ,-0.112856E-07, 0.936398E-08,-0.291882E-08, 0.422266E-09
|
|---|
| 73 | + ,-0.279042E-10, 0.678485E-12, 0.112383E-07,-0.964400E-08
|
|---|
| 74 | + , 0.313121E-08,-0.440224E-09, 0.278668E-10,-0.643012E-12
|
|---|
| 75 | + ,-0.414131E-08, 0.355112E-08,-0.115035E-08, 0.158539E-09
|
|---|
| 76 | + ,-0.976788E-11, 0.216911E-12, 0.521380E-09,-0.442265E-09
|
|---|
| 77 | + , 0.141753E-09,-0.190826E-10, 0.114038E-11,-0.242085E-13/
|
|---|
| 78 | DATA C2/0.572943E-10,-0.296824E-10, 0.630217E-11,-0.623179E-12
|
|---|
| 79 | + , 0.211467E-13,-0.143579E-10,-0.137247E-11, 0.118670E-11
|
|---|
| 80 | + ,-0.793091E-13, 0.124745E-14,-0.269884E-10, 0.125314E-10
|
|---|
| 81 | + ,-0.239259E-11, 0.181151E-12,-0.470277E-14,-0.342454E-11
|
|---|
| 82 | + , 0.976666E-12,-0.236792E-12, 0.213290E-13,-0.607799E-15
|
|---|
| 83 | + ,-0.748844E-12, 0.178214E-12,-0.226827E-13, 0.148441E-14
|
|---|
| 84 | + ,-0.367972E-16, 0.840330E-12, 0.820025E-11,-0.294797E-11
|
|---|
| 85 | + , 0.294669E-12,-0.970294E-14,-0.830636E-12,-0.309273E-11
|
|---|
| 86 | + , 0.124169E-11,-0.135879E-12, 0.481683E-14, 0.438223E-12
|
|---|
| 87 | + , 0.259162E-12,-0.149284E-12, 0.180170E-13,-0.677948E-15/
|
|---|
| 88 | C-----------------------------------------------------------------------
|
|---|
| 89 | GPRSGM=0.
|
|---|
| 90 | C IF ( ECMIN .GT. BCUT ) CUT=ECMIN
|
|---|
| 91 |
|
|---|
| 92 | ECMAX = E - CMUON(10) * Z**OB3
|
|---|
| 93 | IF ( ECMAX .LE. BCUT ) RETURN
|
|---|
| 94 | X = LOG(E/PAMA(5))
|
|---|
| 95 | Y = LOG( BCUT/(VS*E) )
|
|---|
| 96 |
|
|---|
| 97 | S = 0.
|
|---|
| 98 | YY = 1.
|
|---|
| 99 | DO 30 I = 1,2
|
|---|
| 100 | XX = 1.
|
|---|
| 101 | DO 20 J = 1,6
|
|---|
| 102 | K = 6*I + J - 6
|
|---|
| 103 | S = S + C(K) * XX * YY
|
|---|
| 104 | XX = XX * X
|
|---|
| 105 | 20 CONTINUE
|
|---|
| 106 | YY = YY * Y
|
|---|
| 107 | 30 CONTINUE
|
|---|
| 108 | DO 50 I = 3,6
|
|---|
| 109 | XX = 1.
|
|---|
| 110 | DO 40 J = 1,6
|
|---|
| 111 | K = 6*I + J - 6
|
|---|
| 112 | IF ( Y .LE. 0. ) THEN
|
|---|
| 113 | S = S + C(K) * XX * YY
|
|---|
| 114 | ELSE
|
|---|
| 115 | S = S + C(K+24) * XX * YY
|
|---|
| 116 | ENDIF
|
|---|
| 117 | XX = XX * X
|
|---|
| 118 | 40 CONTINUE
|
|---|
| 119 | YY = YY * Y
|
|---|
| 120 | 50 CONTINUE
|
|---|
| 121 | SS = 0.
|
|---|
| 122 | YY = 1.
|
|---|
| 123 | DO 70 I = 1,2
|
|---|
| 124 | XX = 1.
|
|---|
| 125 | DO 60 J = 1,5
|
|---|
| 126 | K = 5*I + J + 55
|
|---|
| 127 | SS = SS + C(K) * XX * YY
|
|---|
| 128 | XX = XX * X
|
|---|
| 129 | 60 CONTINUE
|
|---|
| 130 | YY = YY * Y
|
|---|
| 131 | 70 CONTINUE
|
|---|
| 132 | DO 90 I = 3,5
|
|---|
| 133 | XX = 1.
|
|---|
| 134 | DO 80 J = 1,5
|
|---|
| 135 | K = 5*I + J + 55
|
|---|
| 136 | IF ( Y .LE. 0. ) THEN
|
|---|
| 137 | SS = SS + C(K) * XX * YY
|
|---|
| 138 | ELSE
|
|---|
| 139 | SS = SS + C(K+15) * XX * YY
|
|---|
| 140 | ENDIF
|
|---|
| 141 | XX = XX * X
|
|---|
| 142 | 80 CONTINUE
|
|---|
| 143 | YY = YY * Y
|
|---|
| 144 | 90 CONTINUE
|
|---|
| 145 |
|
|---|
| 146 | S = S + Z * SS
|
|---|
| 147 | IF ( S .LE. 0. ) RETURN
|
|---|
| 148 | C DE/DX SHOULD BE MONOTON INCREASING AS A
|
|---|
| 149 | C FUNCTION OF THE CUT
|
|---|
| 150 | C SOLUTION: LIN. INTERPOLATION FOR 0.2*ECMAX<CUT<ECMAX
|
|---|
| 151 | FAC = 2. * ( LOG(ECMAX/BCUT) )**ALFA
|
|---|
| 152 | FAC = Z * ( Z + AKSI*( 1.+GAM*LOG(Z) ) ) * FAC
|
|---|
| 153 | GPRSGM = FAC * S
|
|---|
| 154 | * IF ( DEBUG ) WRITE(MDEBUG,444) Z,E,GPRSGM
|
|---|
| 155 | * 444 FORMAT(' GPRSGM: Z=',F3.0,' E=',1P,E10.4,' GPRSGM=',E10.4)
|
|---|
| 156 |
|
|---|
| 157 | 99 RETURN
|
|---|
| 158 | END
|
|---|
