15 if(intinfarray(processno)%process .eq.
'pair')
then 17 elseif(intinfarray(processno)%process .eq.
'compt')
then 19 elseif(intinfarray(processno)%process .eq.
'photoe')
then 21 elseif(intinfarray(processno)%process .eq.
'photop')
then 23 elseif(intinfarray(processno)%process .eq.
'cohs')
then 25 elseif(intinfarray(processno)%process .eq.
'mpair')
then 28 write(msg, *)
' process for photon; Proc#=',
30 * intinfarray(processno)%process,
' undef' 32 write(0,
'("energy =",g12.4, "where=",i4, " w=",g12.3)')
33 * movedtrack%p%fm%p(4), movedtrack%where, movedtrack%wgt
34 write(0, * )
" coszenith=", movedtrack%vec%coszenith
35 write(0, *)
' MoveStat=',movestat,
'No Of inte=',
37 do i = 1, numberofinte
38 write(0,*) intinfarray(i)%process,
' dt=',
39 * intinfarray(i)%thickness,intinfarray(i)%length
42 write(0, * )
" (dep,h)B//A==", trackbefmove%pos%depth,
43 * trackbefmove%pos%height,
44 * movedtrack%pos%depth, movedtrack%pos%height
60 real*8 e1, e2, u, eg, cs, sn
61 real*8 teta, teta1, teta2, cos1, sin1, cos2, sin2
69 eg = movedtrack%p%fm%p(4)
70 if(lpmeffect .and. eg .gt. lpmpairemin)
then 72 den = cvh2den(trackbefmove%pos%height)
102 if(teta1 .lt. 0.03
d0)
then 103 cos1 = 1. - teta1**2/2
110 sin2 = sin1 * sqrt( (e1**2-
masele**2)/(e2**2-
masele**2) )
111 if(sin2 .lt. 0.03
d0)
then 114 cos2 = sqrt(1.
d0 - sin2**2)
132 atrack%p%fm%p(4) = e1
135 nproduced = nproduced + 1
136 pwork(nproduced) = atrack%p
143 atrack%p%fm%p(4) = e2
147 nproduced = nproduced + 1
148 pwork(nproduced) = atrack%p
151 atrack%p%fm%p(4) = e1
154 nproduced = nproduced + 1
155 pwork(nproduced) = atrack%p
157 atrack%p%fm%p(4) = e2
160 nproduced = nproduced + 1
161 pwork(nproduced) = atrack%p
176 real*8 eg, e1, cs, sn, cosg, cose
177 real*8 sine, tmp, sing
182 call ccomptea(movedtrack%p%fm%p(4), eg, e1, cosg, cose)
186 tmp=max(1.
d0-cose*cose, 0.
d0)
194 atrack%p%fm%p(4) = e1
197 nproduced = nproduced + 1
198 pwork(nproduced) = atrack%p
200 tmp=max(1.
d0-cosg*cosg, 0.
d0)
206 atrack%p%fm%p(4) = eg
210 nproduced = nproduced + 1
211 pwork(nproduced) = atrack%p
227 character(8):: whichcode
229 if( howphotop == 0 )
then 231 pwork(nproduced+1) = movedtrack%p
232 elseif( howphotop == 1 )
then 234 elseif( howphotop == 2 )
then 235 if( movedtrack%p%fm%p(4) < 2.5 )
then 240 elseif( howphotop == 3 )
then 241 if( movedtrack%p%fm%p(4) < 2.5 )
then 246 elseif( howphotop == 4 )
then 247 whichcode =
"current" 249 write(0,*)
'HowPhotoP =', howphotop,
' invalid ' 253 if( whichcode ==
"sofia" )
then 254 call csofia( targetnucleonno, targetprotonno,
255 * movedtrack%p, pwork(nproduced+1), ngen)
256 elseif( whichcode ==
"current" )
then 257 call cgphad(targetnucleonno, targetprotonno,
258 * movedtrack%p, pwork(nproduced+1), ngen)
260 write(0,*)
' setting mistake of whichcode=',
261 * whichcode,
' in cphotop' 264 nproduced = nproduced + ngen
282 real*8 cosg, tmp, cs, sn, sing
297 nproduced = nproduced + 1
298 pwork(nproduced) = atrack%p
315 real*8 eout, eg, rEg, rEe, cost, a, tmp
317 eg = movedtrack%p%fm%p(4)
326 a = ( targetatomicn/137.0/137.0 + 2.0*ree + reg**2 )/
327 * (2.0*reg*sqrt(2.0*ree) )
339 atrack%p%fm%p(4) = eout
343 nproduced = nproduced + 1
344 pwork(nproduced) = atrack%p
363 e2 = movedtrack%p%fm%p(4) * e2
364 e1=movedtrack%p%fm%p(4) - e2
374 atrack%p%fm%p(4) = e1
377 nproduced = nproduced + 1
378 pwork(nproduced) = atrack%p
380 atrack%p%fm%p(4) = e2
383 nproduced = nproduced + 1
384 pwork(nproduced) = atrack%p
396 call cdpmjet( pj, targetnucleonno, targetprotonno,
398 write(0,*)
' ntp =',ntp
subroutine cerrormsg(msg, needrtn)
subroutine cgphad(massN, atomicN, pj, a, ntp)
subroutine cpairang(e, m, teta)
! for length to thickness conversion or v v ! integer maxnodes real Hinf ! This is used when making table for dim simulation ! The slant length for vertical height to km is ! divided by LenStep m steps ! It can cover the slant length of about km for cos
subroutine cpairerglpm(eg, rho, ee)
subroutine cpairenergy(Eg, Ee)
max ptcl codes in the kelec
subroutine cmpaire(xai, ee, nc)
max ptcl codes in the kseethru ! subcode integer kcasg
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
subroutine ctransvectz(zax, dir1, dir2)
subroutine csetdircos(dc, aTrack)
subroutine ksamprsa(costheta)
subroutine kcossn(cs, sn)
subroutine cmkptc(code, subcode, charge, p)
subroutine cpredpmjet(pj, a, ntp)
subroutine ccomptea(Eg, Egout, Ee, cosg, cose)
subroutine ksamppeang(ain, cost)