2
* $Id: ffxc0i.f,v 1.3 1996/06/03 12:11:43 gj Exp $
4
c Revision 1.3 1996/06/03 12:11:43 gj
5
c Added an error message for ffxc0j with zero masses, which is ill-defined.
7
c Revision 1.2 1995/12/01 15:04:40 gj
8
c Fixed a ridiculous bug: wrong sign for p4^2=0, m2<m1.
12
subroutine ffxc0i(cc0,xpi,dpipj,ier)
13
***#[*comment:***********************************************************
15
* Calculates the infrared finite part of a infrared divergent *
16
* threepoint function with the factor ipi^2. The cutoff *
17
* parameter is assumed to be in a common block /ffcut/. (ugly) *
19
* Input: xpi(6) (real) pi.pi (B&D) *
20
* dpipj(6,6) (real) xpi(i)-xpi(j) *
21
* /ffcut/delta (real) cutoff (either foton mass**2 or *
23
* Output: cc0 (complex) C0, the threepoint function. *
24
* ier (integer) usual error flag *
27
***#]*comment:***********************************************************
35
DOUBLE PRECISION xpi(6),dpipj(6,6)
39
integer init,ipi12,i,ilogi(3),irota,n
41
DOUBLE COMPLEX cs(15),csum,c,clogi(3)
42
DOUBLE PRECISION xqi(6),dqiqj(6,6),qiDqj(6,6),sdel2,xmax,absc,
49
DOUBLE PRECISION delta
55
data inew /1,2,3,4,5,6,
65
absc(c) = abs(DBLE(c)) + abs(DIMAG(c))
75
if ( init .eq. 0 .and. .not.lsmug ) then
77
print *,'ffxc0i: infra-red divergent threepoint function, ',
78
+ 'working with a cutoff ',delta
80
if ( .not.lsmug .and. delta .eq. 0 ) then
86
print *,'ffxc0i: infrared divergent threepoint function'
87
if ( .not.lsmug ) then
88
print *,' cutoff parameter:',delta
94
* rotate to xpi(3)=0, xpi(1)=xpi(6), xpi(2)=xpi(5)
96
call ffrot3(irota,xqi,dqiqj,qiDqj,xpi,dpipj,dum66,6,3,3,ier)
98
* get some dotproducts
101
call ffdot3(qiDqj,xqi,dqiqj,6,ier)
104
fpij3(j,i) = qiDqj(inew(i,irota),inew(j,irota))
108
if ( abs(xqi(4)) .lt. xqi(1) ) then
109
qiDqj(4,1) = dqiqj(2,1) - xqi(4)
112
qiDqj(4,1) = dqiqj(2,4) - xqi(1)
115
if ( lwarn .and. abs(qiDqj(4,1)) .lt. xloss*xmax )
116
+ call ffwarn(156,ier,qiDqj(4,1),xmax)
117
qiDqj(4,1) = qiDqj(4,1)/2
118
qiDqj(1,4) = qiDqj(4,1)
120
if ( abs(xqi(4)) .lt. xqi(2) ) then
121
qiDqj(4,2) = dqiqj(2,1) + xqi(4)
124
qiDqj(4,2) = xqi(2) - dqiqj(1,4)
127
if ( lwarn .and. abs(qiDqj(4,2)) .lt. xloss*xmax )
128
+ call ffwarn(156,ier,qiDqj(4,2),xmax)
129
qiDqj(4,2) = qiDqj(4,2)/2
130
qiDqj(2,4) = qiDqj(4,2)
132
if ( (xqi(1)) .lt. (xqi(2)) ) then
133
qiDqj(1,2) = xqi(1) + dqiqj(2,4)
136
qiDqj(1,2) = xqi(2) + dqiqj(1,4)
139
if ( lwarn .and. abs(qiDqj(1,2)) .lt. xloss*xmax )
140
+ call ffwarn(156,ier,qiDqj(1,2),xmax)
141
qiDqj(1,2) = qiDqj(1,2)/2
142
qiDqj(2,1) = qiDqj(1,2)
151
call ffdel2(del2,qiDqj,6,1,2,4,1,ier)
152
if ( ldot ) fdel2 = del2
154
* the case del2=0 is hopeless - this is really a two-point function
156
if ( del2 .eq. 0 ) then
161
* we cannot yet handle the complex case
163
if ( del2 .gt. 0 ) then
168
sdel2 = isgnal*sqrt(-del2)
170
call ffxc0j(cs,ipi12,sdel2,clogi,ilogi,xqi,dqiqj,qiDqj,
179
if ( .not.lsmug ) then
186
xmax = max(xmax,absc(csum))
188
csum = csum + ipi12*DBLE(pi12)
189
if ( lwarn .and. 2*absc(csum) .lt. xloss*xmax ) then
190
call ffwarn(157,ier,absc(csum),xmax)
192
cc0 = -csum*DBLE(1/(2*sdel2))
197
print '(a)','cs(i) = '
198
print '(i3,2g20.10,1x)',(i,cs(i),i=1,n)
199
print '(a3,2g20.10,1x)','pi ',ipi12*pi12
200
print '(a)','+-----------'
201
print '(a3,2g20.10,1x)','som :',csum
203
print *,'cc0 :',cc0,ier
209
subroutine ffxc0j(cs,ipi12,sdel2i,clogi,ilogi,
210
+ xpi,dpipj,piDpj,delta,npoin,ier)
211
***#[*comment:***********************************************************
213
* Calculates the infrared finite part of a infrared divergent *
214
* threepoint function with the factor ipi^2. *
216
***#]*comment:***********************************************************
222
integer ipi12,ilogi(3),npoin,ier
223
DOUBLE COMPLEX cs(15),clogi(3)
224
DOUBLE PRECISION xpi(6),dpipj(6,6),piDpj(6,6),delta,sdel2i
228
integer i,ieps,ieps1,n,ier0
229
DOUBLE COMPLEX clog1,clog2,cdum(2),cel3,cdyzm,cdyzp,cli,chulp,
231
DOUBLE COMPLEX zfflog,zxfflg,cc
232
DOUBLE PRECISION del2,zm,zp,zm1,zp1,sdel2,hulp,xheck,dum(3),
233
+ dfflo1,dyzp,dyzm,wm,wp,absc,arg1,arg2,del3
241
absc(cc) = abs(DBLE(cc)) + abs(DIMAG(cc))
246
call ffxhck(xpi,dpipj,6,ier)
249
print '(a)',' ##[ ffxc0j:'
250
print *,'ffxc0j: input: '
252
if ( .not.lsmug ) then
253
print *,'delta = ',delta
255
print *,'cmipj(2,2) = ',cmipj(2,2)
256
print *,'cmipj(1,3) = ',cmipj(1,3)
260
* #[ get determinants, roots, ieps:
263
del3 = (- DBLE(xpi(1))*DBLE(cmipj(2,2))**2
264
+ - DBLE(xpi(2))*DBLE(cmipj(1,3))**2
265
+ + 2*DBLE(piDpj(1,2))*DBLE(cmipj(2,2))*
266
+ DBLE(cmipj(1,3)) )/4
267
if ( nschem .ge. 3 ) then
268
cel3 = (- DBLE(xpi(1))*cmipj(2,2)**2
269
+ - DBLE(xpi(2))*cmipj(1,3)**2
270
+ + 2*DBLE(piDpj(1,2))*cmipj(2,2)*cmipj(1,3) )/4
274
if ( lwrite ) print *,'cel3 = ',cel3
278
* the routine as it stands can not handle sdel2<0.
279
* the simplest solution seems to be to switch to sdel2>0 for
280
* the time being - we calculate a complete 3point function so it
281
* should not be a problem (just a sign). Of course this spoils a
282
* good check on the correctness.
285
if ( sdel2i .gt. 0 .and. lwrite ) print *,
286
+ 'ffxc0j: cannot handle sdel2>0, switched to sdel2<0'
288
if ( xpi(4).eq.0 ) then
289
zm = xpi(2)/dpipj(2,1)
290
zm1 = -xpi(1)/dpipj(2,1)
292
call ffroot(zm,zp,xpi(4),piDpj(4,2),xpi(2),sdel2,ier)
293
if ( dpipj(1,2) .ne. 0 ) then
294
call ffroot(zp1,zm1,xpi(4),-piDpj(4,1),xpi(1),sdel2,ier)
301
print *,'ffxc0j: found roots:'
302
print *,' zm = ',zm,zm1
303
if ( xpi(4).ne.0 ) print *,' zp = ',zp,zp1
307
if ( xloss*abs(xheck) .gt. precx*max(x1,abs(zm)) ) print *,
308
+ 'ffxc0j: zm + zm1 <> 1: ',zm,zm1,xheck
309
if ( xpi(4).ne.0 ) then
311
if ( xloss*abs(xheck) .gt. precx*max(x1,abs(zp)) )
312
+ print *,'ffxc0j: zp + zp1 <> 1: ',zp,zp1,xheck
316
* imag sign ok 30-oct-1989
318
if ( xpi(4).ne.0 ) dyzp = -2*sdel2/xpi(4)
320
* #] get determinants, roots, ieps:
321
* #[ the finite+divergent S1:
323
if ( xpi(4).ne.0 ) then
324
call ffcxr(cs(1),ipi12,zm,zm1,zp,zp1,dyzp,
325
+ .FALSE.,x0,x0,x0,.FALSE.,dum,ieps,ier)
328
* Next the divergent piece
330
if ( .not.lsmug ) then
332
* Here we dropped the term log(lam/delta)*log(-zm/zm1)
334
if ( abs(zm1) .gt. 1/xloss ) then
335
clog1 = dfflo1(1/zm1,ier)
336
elseif ( zm.ne.0 ) then
337
clog1 = zxfflg(-zm/zm1,-2,x0,ier)
342
hulp = zm*zm1*4*del2/delta**2
344
* 14-jan-1994: do not count when this is small, this was
345
* meant to be so by the user carefully adjusting delta
348
if ( hulp.eq.0 ) call fferr(97,ier)
349
clog2 = zxfflg(hulp,2,x0,ier0)
350
cs(8) = -clog1*clog2/2
352
* print *,'arg1 = ',-zm/zm1,1/zm1
353
print *,'log1 = ',clog1
354
* print *,'arg2 = ',hulp
355
print *,'log2 = ',clog2
356
print *,'cs(8)= ',cs(8)
360
* checked 4-aug-1992, but found Yet Another Bug 30-sep-1992
362
cdyzm = cel3*DBLE(1/(-2*sdel2*del2))
363
dyzm = del3/(-2*sdel2*del2)
364
carg1 = +cdyzm*DBLE(1/zm)
366
clog1 = zfflog(-carg1,+ieps,DCMPLX(DBLE(zm),DBLE(0)),ier)
367
if (DIMAG(cdyzm) .lt. 0 .and. arg1 .gt. 0 ) then
368
clog1 = clog1 - c2ipi
370
print *,'added -2*pi*i to log1 S1'
371
print *,' arg1,zm = ',arg1,zm
372
print *,'carg1 = ',carg1
377
carg2 = -cdyzm*DBLE(1/zm1)
379
clog2 = zfflog(-carg2,ieps,DCMPLX(DBLE(-zm1),DBLE(0)),ier)
380
if ( DIMAG(cdyzm) .lt. 0 .and. arg2 .gt. 0 ) then
381
clog2 = clog2 + c2ipi
383
print *,'added +2*pi*i to log2 S1'
384
print *,' arg2,zm = ',arg2,zm
385
print *,'carg2 = ',carg2
390
print *,'y=zm = ',zm,zm1
391
if ( xpi(4).ne.0 ) print *,' zp = ',zp,zp1
392
print *,'cdyzm= ',cdyzm
393
print *,'arg1 = ',1/carg1
394
print *,'log1 = ',clog1
395
print *,'cs(8)= ',cs(8)
396
print *,'arg2 = ',1/carg2
397
print *,'log2 = ',clog2
398
print *,'cs(9)= ',cs(9)
399
print *,'ipi12= ',ipi12
400
print *,'S1 = ',cs(1)+cs(2)+cs(3)+cs(4)+cs(5)+cs(6)+
401
+ cs(7)+cs(8)+cs(9)+ipi12*DBLE(pi12)
405
* #] the finite+divergent S1:
406
* #[ log(1) for npoin=4:
407
if ( npoin .eq. 4 ) then
408
if ( ilogi(1) .eq. -999 ) then
409
if ( .not.lsmug ) then
410
hulp = xpi(4)*delta/(4*del2)
412
if ( hulp.eq.0 ) call fferr(97,ier)
413
clogi(1) = -zxfflg(abs(hulp),0,x0,ier0)
414
if ( hulp .lt. 0 ) then
415
if ( xpi(4) .gt. 0 ) then
421
print *,'ffxc0j: I am not 100% sure of the',
422
+ ' terms pi^2, please check against the',
423
+ ' limit lam->0 (id=',id,')'
430
if ( xpi(4).eq.0 ) then
431
print *,'ffxc0i: cannot handle t=0 yet, sorry'
432
print *,'Please regularize with a small mass'
435
chulp = -cdyzm*DBLE(1/dyzp)
437
if ( absc(chulp1) .lt. xloss )
438
+ call ffwarn(129,ier,absc(chulp1),x1)
439
call ffxclg(clogi(1),ilogi(1),chulp,chulp1,dyzp,
444
* #] log(1) for npoin=4:
445
* #[ the log(lam) Si:
446
if ( .not.lsmug ) then
448
* Next the divergent S_i (easy).
449
* The term -2*log(lam/delta)*log(xpi(2)/xpi(1)) has been discarded
450
* with lam the photon mass (regulator).
451
* If delta = sqrt(xpi(1)*xpi(2)) the terms cancel as well
453
if ( dpipj(1,2).ne.0 .and. xloss*abs(xpi(1)*xpi(2)-delta**2)
454
+ .gt.precx*delta**2 ) then
455
if ( xpi(1) .ne. delta ) then
457
if ( xpi(1).eq.0 ) call fferr(97,ier)
458
cs(9) = -zxfflg(xpi(1)/delta,0,x0,ier0)**2 /4
460
if ( xpi(2) .ne. delta ) then
462
if ( xpi(2).eq.0 ) call fferr(97,ier)
463
cs(10) = zxfflg(xpi(2)/delta,0,x0,ier0)**2 /4
467
print *,'cs(9)= ',cs(9)
468
print *,'cs(10)=',cs(10)
470
* #] the log(lam) Si:
471
* #[ the logs for A_i<0:
472
if ( npoin.eq.4 ) then
478
* #] the logs for A_i<0:
479
* #[ the off-shell S3:
482
* the divergent terms in the offshell regulator scheme - not
484
* wm = p3.p2/sqrtdel - 1 = -s1.s2/sqrtdel - 1
485
* wp = p3.p2/sqrtdel + 1 = -s1.s2/sqrtdel + 1
486
* Note that we took the choice sdel2<0 in S1 when
487
* \delta^{p1 s2}_{p1 p2} < 0 by using yp=zm
489
wm = -1 - piDpj(1,2)/sdel2
491
if ( lwrite ) print *,'wm,wp = ',wm,wp
492
if ( abs(wm) .lt. abs(wp) ) then
493
wm = -xpi(5)*xpi(6)/(del2*wp)
494
if ( lwrite ) print *,'wm+ = ',wm
496
wp = -xpi(5)*xpi(6)/(del2*wm)
497
if ( lwrite ) print *,'wp+ = ',wp
502
if ( -DBLE(cmipj(1,3)) .gt. 0 ) then
508
if ( nschem .lt. 3 .or. DIMAG(cmipj(1,3)).eq.0 .and.
509
+ DIMAG(cmipj(2,2)).eq.0 ) then
511
if ( lwrite ) print *,'ffxc0i: Real S3'
515
dyzp = -DBLE(cmipj(1,3))*DBLE(wm)/(2*DBLE(xpi(6))) -
516
+ DBLE(cmipj(2,2))/(2*DBLE(sdel2))
517
dyzm = -DBLE(cmipj(1,3))*DBLE(wp)/(2*DBLE(xpi(6))) -
518
+ DBLE(cmipj(2,2))/(2*DBLE(sdel2))
522
clog1 = zxfflg(-dyzp,-ieps,x1,ier)
525
clog2 = zxfflg(-dyzm,+ieps,x1,ier)
529
if ( dyzp .lt. 0 ) then
534
call ffzxdl(cli,i,cdum(1),hulp,+ieps1,ier)
538
* the log for npoin=4
540
if ( npoin.eq.4 ) then
541
if ( ilogi(3) .eq. -999 ) then
542
if ( DBLE(cmipj(1,3)) .eq. 0 ) then
545
elseif ( dyzp .lt. dyzm ) then
547
chulp1 = +DBLE(cmipj(1,3))/DBLE(xpi(6)*dyzp)
550
chulp1 = -DBLE(cmipj(1,3))/DBLE(xpi(6)*dyzm)
552
call ffxclg(clogi(3),ilogi(3),chulp,chulp1,dyzp,
557
* and some debug output:
561
print *,'y-zm = ',dyzm
562
print *,'y-zp = ',dyzp
563
print *,'+Li2(y/(y-zp)) = ',cs(10)
564
print *,'+Li2(y/(y-zm)) = ',cs(11)
565
print *,'-Li2((y-1)/(y-zm))= ',cs(12)
566
print *,'ipi12 = ',ipi12
571
if ( lwrite ) print *,'ffxc0i: Complex S3'
575
cdyzp = -cmipj(1,3)*DBLE(wm)/(2*DBLE(xpi(6))) -
576
+ cmipj(2,2)/(2*DBLE(sdel2))
577
clog1 = zfflog(-cdyzp,-ieps,c1,ier)
578
if ( ieps*DIMAG(cdyzp).lt.0.and.DBLE(cdyzp).gt.0 ) then
580
print *,'added ',-ieps,'*2*pi*i to log1 S3'
581
print *,'carg1 = ',-cdyzp
582
print *,'clog1 was ',clog1
583
print *,'clog1 is ',clog1 - ieps*c2ipi
585
clog1 = clog1 - ieps*c2ipi
588
print *,'carg1 = ',-cdyzp
589
print *,'clog1 is ',clog2
597
cdyzm = -cmipj(1,3)*DBLE(wp)/(2*DBLE(xpi(6))) -
598
+ cmipj(2,2)/(2*DBLE(sdel2))
599
clog2 = zfflog(-cdyzm,+ieps,c1,ier)
600
if ( ieps*DIMAG(cdyzm).gt.0.and.DBLE(cdyzm).gt.0 ) then
602
print *,'added ',ieps,'*2*pi*i to log2 S3'
603
print *,'carg2 = ',-cdyzm
604
print *,'clog2 was ',clog2
605
print *,'clog2 is ',clog2 + ieps*c2ipi
607
clog2 = clog2 + ieps*c2ipi
611
print *,'carg2 = ',-cdyzm
612
print *,'clog2 is ',clog2
621
hulp = DBLE(cdyzp)/DBLE(cdyzm)
622
if ( DBLE(cdyzp) .lt. 0 ) then
627
if ( DIMAG(chulp) .eq. 0 ) then
629
call ffzxdl(cli,i,cdum(1),hulp,+ieps1,ier)
631
call ffzzdl(cli,i,cdum(1),chulp,ier)
632
if ( hulp.gt.1 .and. ieps1*DIMAG(chulp).lt.0 ) then
634
print *,'addded 2ipi*log(z) to Li'
635
print *,'chulp = ',chulp
636
print *,'cli was ',cli
637
print *,'cli is ',cli +
638
+ ieps1*c2ipi*zfflog(chulp,0,c0,ier)
639
call ffzxdl(cdum(2),i,cdum(1),hulp,+ieps1,
641
print *,'vgl ',cdum(2)
643
cli = cli + ieps1*c2ipi*zfflog(chulp,0,c0,ier)
649
* the log for npoin=4
651
if ( npoin.eq.4 ) then
652
if ( ilogi(3) .eq. -999 ) then
653
if ( cmipj(1,3) .eq. 0 ) then
656
elseif ( DBLE(cdyzp) .lt. DBLE(cdyzm) ) then
658
chulp1 = +cmipj(1,3)/cdyzp*DBLE(1/xpi(6))
661
chulp1 = -cmipj(1,3)/cdyzm*DBLE(1/xpi(6))
664
call ffxclg(clogi(3),ilogi(3),chulp,chulp1,dyzp,
669
* and some debug output:
673
print *,'y-zm = ',cdyzm
674
print *,'y-zp = ',cdyzp
675
print *,'+Li2(y/(y-zp)) = ',cs(10)
676
print *,'+Li2(y/(y-zm)) = ',cs(11)
677
print *,'-Li2((y-1)/(y-zm))= ',cs(12)
678
print *,'ipi12 = ',ipi12
682
* #] the off-shell S3:
683
* #[ the off-shell S2:
687
if ( -DBLE(cmipj(2,2)) .gt. 0 ) then
693
if ( nschem .lt. 3 ) then
695
if ( lwrite ) print *,'ffxc0i: Real S2'
699
dyzm = -DBLE(cmipj(2,2))*DBLE(wp)/(2*DBLE(xpi(5))) -
700
+ DBLE(cmipj(1,3))/(2*DBLE(sdel2))
701
clog1 = zxfflg(+dyzm,-ieps,x1,ier)
707
dyzp = -DBLE(cmipj(2,2))*DBLE(wm)/(2*DBLE(xpi(5))) -
708
+ DBLE(cmipj(1,3))/(2*DBLE(sdel2))
709
clog2 = zxfflg(+dyzp,+ieps,x1,ier)
713
if ( dyzm .lt. 0 ) then
718
call ffzxdl(cli,i,cdum(1),hulp,-ieps1,ier)
722
* the log for npoin=4
724
if ( npoin.eq.4 ) then
725
if ( ilogi(2) .eq. -999 ) then
726
if ( DBLE(cmipj(2,2)) .eq. 0 ) then
729
elseif ( dyzp .lt. dyzm ) then
731
chulp1 = +DBLE(cmipj(2,2))/DBLE(xpi(5)*dyzp)
732
elseif ( dyzp .gt. dyzm ) then
734
chulp1 = -DBLE(cmipj(2,2))/DBLE(xpi(5)*dyzm)
736
call ffxclg(clogi(2),ilogi(2),chulp,chulp1,dyzp,
741
* and some debug output:
745
print *,'y-zm = ',dyzm
746
print *,'y-zp = ',dyzp
747
print *,'-Li2((y-1)/(y-zm))= ',cs(13)
748
print *,'-Li2((y-1)/(y-zp))= ',cs(14)
749
print *,'+Li2(y/(y-zp)) = ',cs(15)
750
print *,'ipi12 = ',ipi12
755
if ( lwrite ) print *,'ffxc0i: Complex S2'
759
cdyzm = -cmipj(2,2)*DBLE(wp)/(2*DBLE(xpi(5))) -
760
+ cmipj(1,3)/(2*DBLE(sdel2))
761
clog1 = zfflog(+cdyzm,-ieps,c1,ier)
762
if ( DBLE(cdyzm).lt.0.and.ieps*DIMAG(cdyzm).gt.0 ) then
763
if ( lwrite ) print *,'added 2*i*pi to log1'
764
clog1 = clog1 - ieps*c2ipi
771
cdyzp = -cmipj(2,2)*DBLE(wm)/(2*DBLE(xpi(5))) -
772
+ cmipj(1,3)/(2*DBLE(sdel2))
773
clog2 = zfflog(+cdyzp,+ieps,c1,ier)
774
if ( DBLE(cdyzp).lt.0.and.ieps*DIMAG(cdyzp).lt.0 ) then
776
print *,'added ',ieps,'*2*pi*i to log2 S2'
777
print *,'carg1 = ',+cdyzp
779
clog2 = clog2 + ieps*c2ipi
787
hulp = DBLE(dyzm)/DBLE(dyzp)
788
if ( DBLE(cdyzm) .lt. 0 ) then
793
if ( DIMAG(chulp ) .eq. 0 ) then
795
call ffzxdl(cli,i,cdum(1),hulp,-ieps1,ier)
797
call ffzzdl(cli,i,cdum(1),chulp,ier)
798
if ( hulp.gt.1 .and. ieps1*DIMAG(chulp).gt.0 ) then
800
print *,'addded 2ipi*log(z) to Li'
801
print *,'chulp = ',chulp
802
print *,'cli was ',cli
803
print *,'cli is ',cli -
804
+ ieps1*c2ipi*zfflog(chulp,0,c0,ier)
805
call ffzxdl(cdum(2),i,cdum(1),hulp,-ieps1,
807
print *,'vgl ',cdum(2)
809
cli = cli - ieps1*c2ipi*zfflog(chulp,0,c0,ier)
815
* the log for npoin=4
817
if ( npoin.eq.4 ) then
818
if ( ilogi(2) .eq. -999 ) then
819
if ( cmipj(2,2) .eq. 0 ) then
822
elseif ( DBLE(cdyzp) .lt. DBLE(cdyzm) ) then
824
chulp1 = +cmipj(2,2)/cdyzp*DBLE(1/xpi(5))
825
elseif ( DBLE(cdyzp) .gt. DBLE(cdyzm) ) then
827
chulp1 = -cmipj(2,2)/cdyzm*DBLE(1/xpi(5))
830
call ffxclg(clogi(2),ilogi(2),chulp,chulp1,dyzp,
835
* and some debug output:
839
print *,'y-zm = ',cdyzm
840
print *,'y-zp = ',cdyzp
841
print *,'-Li2((y-1)/(y-zm))= ',cs(13)
842
print *,'-Li2((y-1)/(y-zp))= ',cs(14)
843
print *,'+Li2(y/(y-zp)) = ',cs(15)
844
print *,'ipi12 = ',ipi12
849
* #] the off-shell S2:
851
if ( sdel2i.gt.0 .neqv. xpi(4).eq.0.and.xpi(1).gt.xpi(2) ) then
852
if ( .not.lsmug ) then
861
if ( npoin.eq.4 ) then
868
if ( lwrite ) print '(a)',' ##] ffxc0j:'
873
subroutine ffxclg(clg,ilg,chulp,chulp1,dyzp,ier)
874
***#[*comment:***********************************************************
876
* compute the extra logs for npoin=4 given chulp=-cdyzm/cdyzp *
877
* all flagchecking has already been done. *
879
* Input: chulp (complex) see above *
880
* chulp1 (complex) 1+chulp (in case chulp ~ -1) *
881
* dyzp (real) (real part of) y-z+ for im part *
882
* Output: clg (complex) the log *
883
* ilg (integer) factor i*pi split off clg *
885
***#]*comment:***********************************************************
892
DOUBLE PRECISION dyzp
893
DOUBLE COMPLEX clg,chulp,chulp1
897
DOUBLE PRECISION hulp,hulp1,dfflo1
898
DOUBLE COMPLEX zxfflg,zfflog,zfflo1,check
907
check = c1 + chulp - chulp1
908
if ( xloss*abs(check) .gt. precc*max(abs(c1),abs(chulp)) )
909
+ print *,'ffxclg: error: chulp1 != 1+chulp: ',chulp1,
915
if ( DIMAG(chulp) .eq. 0 ) then
918
if ( abs(hulp1) .lt. xloss ) then
919
clg = DBLE(dfflo1(hulp1,ier))
921
clg = zxfflg(abs(hulp),0,x0,ier)
923
if ( hulp .lt. 0 ) then
924
if ( dyzp.lt.0 ) then
932
if ( lwrite ) print *,'clg(real) = ',clg+c2ipi*ilg/2
935
* may have to be improved
937
if ( abs(DBLE(chulp1))+abs(DIMAG(chulp1)) .lt. xloss ) then
938
clg = zfflo1(chulp1,ier)
940
clg = zfflog(chulp,0,c0,ier)
943
if ( DBLE(chulp) .lt. 0 ) then
944
if ( dyzp.lt.0 .and. DIMAG(clg).lt.0 ) then
945
if ( lwrite ) print *,'ffxclg: added -2*pi to log'
947
elseif ( dyzp.gt.0 .and. DIMAG(clg).gt.0 ) then
948
if ( lwrite ) print *,'ffxclg: added +2*pi to log'
952
if ( lwrite ) print *,'clg(cmplx)= ',clg+c2ipi*ilg/2
added
removed
vendor/CutTools/src/qcdloop/ffxc0i.f
