2 SUBROUTINE initwkswdelt(mode,IDEX,IDFX,SVAR,SWSQEFF, DELTSQ, DeltV, GMU, ALPHAINV, AMZi, GAMMZi, KEYGSW,
3 &ReGSW1,CImGSW1,ReGSW2,CImGSW2,ReGSW3,CImGSW3,ReGSW4,CImGSW4,ReGSW6,CImGSW6 )
7 IMPLICIT REAL*8 (a-h,o-z)
8 COMMON / t_beampm / ene ,amin,amfin,ide,idf
10 COMMON / t_gauspm /ss,poln,t3e,qe,t3f,qf
11 & ,xupgi0 ,xupzi0 ,xupgf0 ,xupzf0
12 & ,ndiag0,ndiaga,keya,keyz
13 & ,itce,jtce,itcf,jtcf,kolor
14 real*8 ss,poln,t3e,qe,t3f,qf
15 & ,xupgi0(2),xupzi0(2),xupgf0(2),xupzf0(2)
16 COMMON / t_gauspm1/vvcor, zetvpi, gamvpi
17 & ,xupgi ,xupzi ,xupgf ,xupzf
18 COMPLEX*16 VVcor, ZetVPi, GamVPi
19 COMPLEX*16 XUPGI(2),XUPZI(2),XUPGF(2),XUPZF(2)
21 COMMON / t_gswprmn /swsq,amw,amz,amh,amtop,gammz
22 real*8 swsq,amw,amz,amh,amtop,gammz
23 COMMON / t_ewn / gmun, alphainvn
24 real*8 gmun, alphainvn
27 DATA pi /3.141592653589793238462643d0/
28 gsw(1) = dcmplx(regsw1,cimgsw1)
29 gsw(2) = dcmplx(regsw2,cimgsw2)
30 gsw(3) = dcmplx(regsw3,cimgsw3)
31 gsw(4) = dcmplx(regsw4,cimgsw4)
33 gsw(6) = dcmplx(regsw6,cimgsw6)
55 zetvpi = gfermi *amz**2 *alphainv /(dsqrt(2.d0)*8.d0*pi
56 $ *(swsq*(1d0-swsq)) *16d0
66 gamvpi = 1d0 /(2d0-gsw(6))
74 ELSEIF (idfx.EQ.-11)
then
77 ELSEIF (idfx.EQ. 15)
then
80 ELSEIF (idfx.EQ.-15)
then
84 WRITE(*,*)
'INITWKSW: WRONG IDFX'
91 ELSEIF (idex.EQ.-11)
then
94 ELSEIF (idex.EQ. 13)
then
97 ELSEIF (idex.EQ.-13)
then
100 ELSEIF (idex.EQ. 1)
then
103 ELSEIF (idex.EQ.- 1)
then
106 ELSEIF (idex.EQ. 2)
then
109 ELSEIF (idex.EQ.- 2)
then
112 ELSEIF (idex.EQ. 3)
then
115 ELSEIF (idex.EQ.- 3)
then
118 ELSEIF (idex.EQ. 4)
then
121 ELSEIF (idex.EQ.- 4)
then
124 ELSEIF (idex.EQ. 5)
then
127 ELSEIF (idex.EQ.- 5)
then
130 ELSEIF (idex.EQ. 12)
then
133 ELSEIF (idex.EQ.- 12)
then
136 ELSEIF (idex.EQ. 14)
then
139 ELSEIF (idex.EQ.- 14)
then
142 ELSEIF (idex.EQ. 16)
then
145 ELSEIF (idex.EQ.- 16)
then
150 WRITE(*,*)
'INITWKSW: WRONG IDEX'
164 CALL t_givizo( ide, 1,aizor,qe,kdumm)
165 CALL t_givizo( ide,-1,aizol,qe,kdumm)
168 t3e = (aizol+aizor)/2.
169 xupzi(1)=(aizor-qe*(swsq+deltsq)*gsw(3)-qe*deltv)/sqrt(swsq*(1-swsq
170 xupzi(2)=(aizol-qe*(swsq+deltsq)*gsw(3)-qe*deltv)/sqrt(swsq*(1-swsq
171 ve =(xupzi(1)+xupzi(2))/2.
172 CALL t_givizo( idf, 1,aizor,qf,kolor)
173 CALL t_givizo( idf,-1,aizol,qf,kolor)
176 t3f = (aizol+aizor)/2.
177 xupzf(1)=(aizor-qf*(swsq+deltsq)*gsw(2)-qf*deltv)/sqrt(swsq*(1-swsq
178 xupzf(2)=(aizol-qf*(swsq+deltsq)*gsw(2)-qf*deltv)/sqrt(swsq*(1-swsq
179 vf =(xupzf(1)+xupzf(2))/2.
182 deno = dsqrt(swsq*(1d0-swsq))
188 vvcef = ( (t3e) *(t3f)
189 $ -(qe*swsq+deltsq) *(t3f) *gsw(3) -qe*(t3f)*deltv
190 $ -(qf*swsq+deltsq) *(t3e) *gsw(2) -qf*(t3e)*deltv
191 $ + (qe*swsq) *(qf*swsq) *gsw(4)
192 $ + 2*qe*qf*deltsq*swsq + 2*qe*qf*deltv*swsq )/deno**2
195 IF(keygsw.NE.0.AND.keygsw.NE.4)
THEN
196 vvcor = vvcef/(ve*vf)
208 FUNCTION t_bornew(MODE,KEYGSW,SVAR,COSTHE,TA,TB)
222 IMPLICIT REAL*8(a-h,o-z)
223 COMMON / t_beampm / ene ,amin,amfin,ide,idf
224 real*8 ene ,amin,amfin
225 COMMON / t_gauspm /ss,poln,t3e,qe,t3f,qf
226 & ,xupgi0 ,xupzi0 ,xupgf0 ,xupzf0
227 & ,ndiag0,ndiaga,keya,keyz
228 & ,itce,jtce,itcf,jtcf,kolor
229 real*8 ss,poln,t3e,qe,t3f,qf
230 & ,xupgi0(2),xupzi0(2),xupgf0(2),xupzf0(2)
231 COMMON / t_gauspm1/vvcor, zetvpi, gamvpi
232 & ,xupgi ,xupzi ,xupgf ,xupzf
233 COMPLEX*16 VVcor, ZetVPi, GamVPi
234 COMPLEX*16 XUPGI(2),XUPZI(2),XUPGF(2),XUPZF(2)
235 COMMON / t_ewn / gmun, alphainvn
236 real*8 gmun, alphainvn
241 COMMON / t_gswprmn /swsq,amw,amz,amh,amtop,gammz
242 real*8 swsq,amw,amz,amh,amtop,gammz
248 COMPLEX*16 ABORN(2,2),APHOT(2,2),AZETT(2,2)
249 COMPLEX*16 XUPZFP(2),XUPZIP(2),XUPZIF(2,2)
250 COMPLEX*16 ABORNM(2,2),APHOTM(2,2),AZETTM(2,2)
251 COMPLEX*16 PROPA,PROPZ
255 DATA xi/(0.d0,1.d0)/,xr/(1.d0,0.d0)/
258 DATA svar0,cost0 /-5.d0,-6.d0/
259 DATA pi /3.141592653589793238462643d0/
260 DATA seps1,seps2 /0d0,0d0/
264 IF ( mode.NE.mode0.OR.svar.NE.svar0.OR.costhe.NE.cost0
265 $ .OR.ide0.NE.ide)
THEN
276 sinthe=sqrt(1.d0-costhe**2)
277 beta=sqrt(max(0d0,1d0-4d0*amfin**2/svar))
280 xupzfp(1)=0.5d0*(xupzf(1)+xupzf(2))+0.5d0*beta*(xupzf(1)-xupzf(2
281 xupzfp(2)=0.5d0*(xupzf(1)+xupzf(2))-0.5d0*beta*(xupzf(1)-xupzf(2
282 xupzip(1)=0.5d0*(xupzi(1)+xupzi(2))+0.5d0*(xupzi(1)-xupzi(2))
283 xupzip(2)=0.5d0*(xupzi(1)+xupzi(2))-0.5d0*(xupzi(1)-xupzi(2))
284 xupzif(1,1)=(0.5d0*(xupzi(1)+xupzi(2))+0.5d0*(xupzi(1)-xupzi(2))
285 $ +(0.5d0*(xupzi(1)+xupzi(2)))*(0.5d0*(xupzf(1)+xupzf(2
286 xupzif(1,2)=(0.5d0*(xupzi(1)+xupzi(2))+0.5d0*(xupzi(1)-xupzi(2))
287 $ +(0.5d0*(xupzi(1)+xupzi(2)))*(0.5d0*(xupzf(1)+xupzf(2
288 xupzif(2,1)=(0.5d0*(xupzi(1)+xupzi(2))-0.5d0*(xupzi(1)-xupzi(2))
289 $ +(0.5d0*(xupzi(1)+xupzi(2)))*(0.5d0*(xupzf(1)+xupzf(2
290 xupzif(2,2)=(0.5d0*(xupzi(1)+xupzi(2))-0.5d0*(xupzi(1)-xupzi(2))
291 $ +(0.5d0*(xupzi(1)+xupzi(2)))*(0.5d0*(xupzf(1)+xupzf(2
294 xupf =0.5d0*(xupzf(1)+xupzf(2))
295 xupi =0.5d0*(xupzi(1)+xupzi(2))
299 propa =1d0/svar*gamvpi
301 propz =1d0/dcmplx(svar-amz**2,svar/amz*gammz)*zetvpi
304 IF( keygsw. eq. 2)
THEN
307 zetv = gfermi *amz**2 *alphainv /(dsqrt(2.d0)*8.d0*pi)
308 $ *(swsq*(1d0-swsq)) *16d0
319 propz =1d0/dcmplx(svar-amz**2 ,
320 $ gammz*svar/amz )*zetv
324 IF( keygsw. eq. 10)
THEN
327 propz =1d0/dcmplx(svar-amz**2/(1+gammz**2/amz**2),
328 $ amz*gammz /(1+gammz**2/amz**2) )
330 propz =propz*dcmplx(1,-gammz/amz/(1+gammz**2/amz**2))
333 IF (keygsw.EQ.0) propa=0.d0
336 regula= (3-2*i)*(3-2*j) + costhe
337 regulm=-(3-2*i)*(3-2*j) * sinthe *2.d0*amfin/sqrt(svar)
338 aphot(i,j)=propa*(xupgi(i)*xupgf(j)*regula)
339 azett(i,j)=propz*(xupzip(i)*xupzfp(j)+xthing)*regula
340 azett(i,j)=propz*(xupzif(i,j)+xthing)*regula
341 aborn(i,j)=aphot(i,j)+azett(i,j)
342 aphotm(i,j)=propa*dcmplx(0d0,1d0)*xupgi(i)*xupgf(j)*regulm
343 azettm(i,j)=propz*dcmplx(0d0,1d0)*(xupzip(i)*xupf+xthing)*regulm
344 abornm(i,j)=aphotm(i,j)+azettm(i,j)
359 factor=kolor*(1d0+helic*polar1)*(1d0-helic*polar2)/4d0
360 factom=factor*(1+helit*ta)*(1-helit*tb)
361 factor=factor*(1+helit*ta)*(1+helit*tb)
363 born=born+cdabs(aborn(i,j))**2*factor
366 born=born+cdabs(abornm(i,j))**2*factom
372 IF(funt.LT.0.d0) funt=born
375 IF (svar.GT.4d0*amfin**2)
THEN
377 thresh=sqrt(1-4d0*amfin**2/svar)
378 t_bornew= funt*svar**2*thresh