JHUGen MELA  JHUGen v7.5.6, MELA v2.4.2
Matrix element calculations as used in JHUGen.
collier_coefs.F90
Go to the documentation of this file.
1 !!
2 !! File collier_coefs.F90 is part of COLLIER
3 !! - A Complex One-Loop Library In Extended Regularizations
4 !!
5 !! Copyright (C) 2015, 2016 Ansgar Denner, Stefan Dittmaier, Lars Hofer
6 !!
7 !! COLLIER is licenced under the GNU GPL version 3, see COPYING for details.
8 !!
9 
10 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
11 !
12 ! *******************************************
13 ! * C O L L I E R *
14 ! * *
15 ! * Complex One-Loop Library *
16 ! * In Extended Regularizations *
17 ! * *
18 ! * by A.Denner, S.Dittmaier, L.Hofer *
19 ! * *
20 ! * version 1.2 *
21 ! * *
22 ! *******************************************
23 !
24 !
25 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
26 
27 
28 module collier_coefs
29 
30  use combinatorics
31  use collier_global
32  use collier_init
33  use collier_aux
34  use reductiontn
35 
36  implicit none
37 
38 
39 
40  interface b_cll
41  module procedure b_main_cll,b_arrays_cll, &
42  b_list_cll,b_arrays_list_cll
43  end interface b_cll
44 
45 
46  interface c_cll
47  module procedure c_main_cll,c_arrays_cll, &
48  c_list_cll,c_arrays_list_cll
49  end interface c_cll
50 
51 
52  interface d_cll
53  module procedure d_main_cll,d_arrays_cll, &
54  d_list_cll,d_arrays_list_cll
55  end interface d_cll
56 
57 
58  interface e_cll
59  module procedure e_main_cll,e_arrays_cll, &
60  e_list_cll,e_arrays_list_cll
61  end interface e_cll
62 
63 
64  interface f_cll
65  module procedure f_main_cll,f_arrays_cll, &
66  f_list_cll,f_arrays_list_cll
67  end interface f_cll
68 
69 
70  interface g_cll
71  module procedure g_main_cll,g_arrays_cll, &
72  g_list_cll,g_arrays_list_cll
73  end interface g_cll
74 
75 
76  interface tn_cll
77  module procedure tn_main_cll,t1_cll
78  end interface tn_cll
79 
80 
81  interface b0_cll
82  module procedure b0_main_cll,b0_arrays_cll
83  end interface b0_cll
84 
85 
86  interface c0_cll
87  module procedure c0_main_cll,c0_arrays_cll
88  end interface c0_cll
89 
90 
91  interface d0_cll
92  module procedure d0_main_cll,d0_arrays_cll
93  end interface d0_cll
94 
95 
96  interface e0_cll
97  module procedure e0_main_cll,e0_arrays_cll
98  end interface e0_cll
99 
100 
101  interface f0_cll
102  module procedure f0_main_cll,f0_arrays_cll
103  end interface f0_cll
104 
105 
106  interface db0_cll
107  module procedure db0_main_cll,db0_arrays_cll
108  end interface db0_cll
109 
110 
111  interface db1_cll
112  module procedure db1_main_cll,db1_arrays_cll
113  end interface db1_cll
114 
115 
116  interface db00_cll
117  module procedure db00_main_cll,db00_arrays_cll
118  end interface db00_cll
119 
120 
121  interface db11_cll
122  module procedure db11_main_cll,db11_arrays_cll
123  end interface db11_cll
124 
125 
126  interface db_cll
127  module procedure db_main_cll,db_arrays_cll
128 ! DB_list_cll,DB_arrays_list_cll
129  end interface db_cll
130 
131 
132 
133 contains
134 
135 
136  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
137  ! subroutine A_cll(A,Auv,m02,rmax,Aerr,id_in)
138  !
139  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
140 
141  subroutine a_cll(A,Auv,m02,rmax,Aerr,id_in)
142 
143  integer, intent(in) :: rmax
144  double complex, intent(in) :: m02
145  double complex :: mm02
146  double complex, intent(out) :: Auv(0:rmax/2), A(0:rmax/2)
147  double precision, optional, intent(out) :: Aerr(0:rmax)
148  integer, optional, intent(in) :: id_in
149  double complex :: A2uv(0:rmax/2), A2(0:rmax/2)
150  double complex :: Adduv(0:rmax/2), Add(0:rmax/2)
151  double precision :: Aerraux(0:rmax),Adiff(0:rmax)
152  double complex :: args(1)
153  integer :: n0, i, rank,errflag,id
154  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD),Aacc(0:rmax)
155  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
156  double precision :: norm,norm_coli,norm_dd
157  integer :: accflagDD,errflagDD,NDD,rankDD
158  logical :: mflag,eflag
159 
160  if (1.gt.nmax_cll) then
161  call seterrflag_cll(-10)
162  call errout_cll('A_cll','Nmax_cll smaller 1',eflag,.true.)
163  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
164  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 1'
165  call propagateerrflag_cll
166  return
167  end if
168  if (rmax.gt.rmax_cll) then
169  call seterrflag_cll(-10)
170  call errout_cll('A_cll','argument rmax larger than rmax_cll',eflag,.true.)
171  write(nerrout_cll,*) 'rmax =',rmax
172  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
173  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
174  call propagateerrflag_cll
175  return
176  end if
177 
178  mflag=.true.
179  if (present(id_in)) then
180  mflag=.false.
181  id = id_in
182  else
183  id = 0
184  end if
185 
186  if (mflag) then
187  args(1) = m02
188  call setmasterfname_cll('A_cll')
189  call setmastern_cll(1)
190  call setmasterr_cll(rmax)
191  call setmasterargs_cll(1,args)
192 
193  call settencache_cll(never_tenred_cll)
194  end if
195 
196 
197  select case (mode_cll)
198 
199  case (1)
200  ! calculate loop integral using
201  ! COLI implementation by AD/LH
202 
203  call calca(a,auv,m02,rmax,aerraux)
204  if (abs(a(0)).ne.0d0) then
205  aacc=aerraux/abs(a(0))
206  else
207  aacc=0d0
208  end if
209  if (present(aerr)) aerr=aerraux
210  if (mflag) call propagateaccflag_cll(aacc,rmax)
211 
212 
213  case (2)
214  ! calculate loop integral using
215  ! DD implementation by SD
216 
217  id=0
218 
219  ! replace small masses by DD-identifiers
220  mm02 = getminf2dd_cll(m02)
221 
222  rank = rmax
223  call a_dd(add,adduv,mm02,rank,id)
224 
225  do n0=0,rank/2
226  a(n0) = add(n0)
227  auv(n0) = adduv(n0)
228  end do
229 
230  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
231  if (present(aerr)) then
232  aerr(0:rmax) = accabsdd(0:rmax)
233  endif
234  if (abs(a(0)).ne.0d0) then
235  aacc=accabsdd(0:rmax)/abs(a(0))
236  else
237  aacc=0d0
238  end if
239  if (mflag) call propagateaccflag_cll(aacc,rmax)
240 
241  case (3)
242  ! cross-check mode
243  ! compare results for loop integral
244  ! from COLI implementation by AD/LH and
245  ! from DD implementation by SD
246 
247  ! calculate loop integral using COLI
248  call calca(a,auv,m02,rmax,aerraux)
249 
250 
251  ! calculate loop integral using DD
252 
253  id=0
254 
255  ! replace small masses by DD-identifiers
256  mm02 = getminf2dd_cll(m02)
257 
258  rank = rmax
259  call a_dd(add,adduv,mm02,rank,id)
260  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
261 
262  do n0=0,rank/2
263  a2(n0) = add(n0)
264  a2uv(n0) = adduv(n0)
265  end do
266 
267 
268  ! cross-check
269 
270  norm_coli = abs(a(0))
271  if(norm_coli.eq.0d0) norm_coli = muuv2_cll
272  norm_dd = abs(a2(0))
273  if(norm_coli.eq.0d0) norm_dd = muuv2_cll
274  norm = min(norm_coli,norm_dd)
275 
276  call checkcoefsa_cll(a,a2,m02,rmax,norm,adiff)
277 
278  if (aerraux(rmax).lt.accabsdd(rmax)) then
279  if (present(aerr)) aerr = max(aerraux,adiff)
280  aacc = max(aerraux/norm_coli,adiff/norm)
281  if (monitoring) pointscnta_coli = pointscnta_coli + 1
282  else
283  a = a2
284  auv = a2uv
285  if (present(aerr)) aerr = max(accabsdd(0:rmax),adiff)
286  aacc = max(accabsdd(0:rmax)/norm_dd,adiff/norm)
287  if (monitoring) pointscnta_dd = pointscnta_dd + 1
288  end if
289 
290  if (mflag) call propagateaccflag_cll(aacc,rmax)
291 
292  end select
293 
294  if (mflag) call propagateerrflag_cll
295 
296  if (monitoring) then
297  pointscnta_cll = pointscnta_cll + 1
298 
299  if(maxval(aacc).gt.reqacc_cll) accpointscnta_cll = accpointscnta_cll + 1
300 
301  if(maxval(aacc).gt.critacc_cll) then
302  critpointscnta_cll = critpointscnta_cll + 1
303  if ( critpointscnta_cll.le.noutcritpointsmax_cll(1)) then
304  call critpointsout_cll('A_cll',0,maxval(aacc), critpointscnta_cll)
305  if( critpointscnta_cll.eq.noutcritpointsmax_cll(1)) then
306  write(ncpout_cll,*) ' Further output of Critical Points for A_cll suppressed '
307  write(ncpout_cll,*)
308  endif
309  end if
310  end if
311 
312  end if
313 
314 
315  end subroutine a_cll
316 
317 
318 
319 
320 
321  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
322  ! subroutine B_main_cll(B,Buv,p10,m02,m12,rmax,Berr,id_in)
323  !
324  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
325 
326  subroutine b_main_cll(B,Buv,p10,m02,m12,rmax,Berr,id_in)
327 
328  integer, intent(in) :: rmax
329  double complex, intent(in) :: p10,m02,m12
330  double precision :: q10
331  double complex :: mm02,mm12
332  double complex, intent(out) :: Buv(0:rmax/2,0:rmax)
333  double complex, intent(out) :: B(0:rmax/2,0:rmax)
334  double precision, optional, intent(out) :: Berr(0:rmax)
335  integer, optional, intent(in) :: id_in
336  double complex :: B2uv(0:rmax/2,0:rmax), B2(0:rmax/2,0:rmax)
337  double complex :: Bcoliuv(0:rmax,0:rmax)
338  double complex :: Bcoli(0:rmax,0:rmax)
339  double complex :: Bdduv(0:rmax,0:rmax)
340  double complex :: Bdd(0:rmax,0:rmax)
341  double precision :: Berraux(0:rmax),Bdiff(0:rmax)
342  double complex :: args(3)
343  integer :: n0,rank,errflag,id,r
344  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD)
345  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
346  double precision :: Bacc(0:rmax),Bacc2(0:rmax),norm,norm_coli,norm_dd
347  integer :: accflagDD,errflagDD,NDD,rankDD
348  logical :: mflag,eflag
349 
350  if (2.gt.nmax_cll) then
351  call seterrflag_cll(-10)
352  call errout_cll('B_cll','Nmax_cll smaller 2',eflag,.true.)
353  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
354  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 2'
355  call propagateerrflag_cll
356  return
357  end if
358  if (rmax.gt.rmax_cll) then
359  call seterrflag_cll(-10)
360  call errout_cll('B_cll','argument rmax larger than rmax_cll',eflag,.true.)
361  write(nerrout_cll,*) 'rmax =',rmax
362  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
363  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
364  call propagateerrflag_cll
365  return
366  end if
367 
368  mflag=.true.
369  if (present(id_in)) then
370  mflag=.false.
371  id = id_in
372  else
373  id = 0
374  end if
375 
376  if (mflag) then
377  ! set ID of master call
378  args(1) = p10
379  args(2) = m02
380  args(3) = m12
381  call setmasterfname_cll('B_cll')
382  call setmastern_cll(2)
383  call setmasterr_cll(rmax)
384  call setmasterargs_cll(3,args)
385 
386  call settencache_cll(never_tenred_cll)
387  end if
388 
389 
390  select case (mode_cll)
391 
392  case (1)
393  ! calculate loop integral using
394  ! COLI implementation by AD/LH
395 
396  call calcb(bcoli,bcoliuv,p10,m02,m12,rmax,id,berraux)
397 
398  norm = maxval(abs(bcoli(0,0:rmax)))
399  if (norm.ne.0d0) then
400  bacc = berraux/norm
401  else
402  bacc = berraux
403  end if
404 
405  if (present(berr)) then
406  berr = berraux
407  end if
408 
409  if (mflag) call propagateaccflag_cll(bacc,rmax)
410 
411  b(0:rmax/2,0:rmax) = bcoli(0:rmax/2,0:rmax)
412  buv(0:rmax/2,0:rmax) = bcoliuv(0:rmax/2,0:rmax)
413 
414  case (2)
415  ! calculate loop integral using
416  ! DD implementation by SD
417 
418  id=0
419 
420  ! replace small masses by DD-identifiers
421  q10 = dreal(getminf2dd_cll(p10))
422  mm02 = getminf2dd_cll(m02)
423  mm12 = getminf2dd_cll(m12)
424 
425  rank = rmax
426  call b_dd(bdd,bdduv,q10,mm02,mm12,rank,id)
427  do n0=0,rank/2
428  b(n0,0:rank) = bdd(n0,0:rank)
429  buv(n0,0:rank) = bdduv(n0,0:rank)
430  end do
431 
432  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
433  if (present(berr)) then
434  berr(0:rmax) = accabsdd(0:rmax)
435  end if
436 
437  norm = maxval(abs(b(0,0:rmax)))
438  if (norm.ne.0d0) then
439  bacc = accabsdd(0:rmax)/norm
440  else
441  bacc = accabsdd(0:rmax)
442  end if
443  if (mflag) call propagateaccflag_cll(bacc,rmax)
444 
445 
446  case (3)
447  ! cross-check mode
448  ! compare results for loop integral
449  ! from COLI implementation by AD/LH and
450  ! from DD implementation by SD
451 
452  ! calculate loop integral using COLI
453  call calcb(bcoli,bcoliuv,p10,m02,m12,rmax,id,berraux)
454 
455  b(0:rmax/2,0:rmax) = bcoli(0:rmax/2,0:rmax)
456  buv(0:rmax/2,0:rmax) = bcoliuv(0:rmax/2,0:rmax)
457 
458 
459  ! calculate loop integral using DD
460 
461  id=0
462 
463  ! replace small masses by DD-identifiers
464  q10 = dreal(getminf2dd_cll(p10))
465  mm02 = getminf2dd_cll(m02)
466  mm12 = getminf2dd_cll(m12)
467 
468  rank = rmax
469  call b_dd(bdd,bdduv,q10,mm02,mm12,rank,0)
470  do n0=0,rank/2
471  b2(n0,0:rmax) = bdd(n0,0:rmax)
472  b2uv(n0,0:rmax) = bdduv(n0,0:rmax)
473  end do
474  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
475 
476  norm_coli = maxval(abs(b(0,0:rmax)))
477  if (norm_coli.eq.0d0) norm_coli = 1d0
478  norm_dd = maxval(abs(b2(0,0:rmax)))
479  if (norm_dd.eq.0d0) norm_dd = 1d0
480  norm = min(norm_coli,norm_dd)
481 
482  ! cross-check
483  call checkcoefsb_cll(b,b2,p10,m02,m12,rmax,norm,bdiff)
484 
485  if (berraux(rmax).lt.accabsdd(rmax)) then
486  if (present(berr)) berr = max(berraux,bdiff)
487  bacc = max(berraux/norm_coli,bdiff/norm)
488  if (monitoring) pointscntb_coli = pointscntb_coli + 1
489  else
490  b = b2
491  buv = b2uv
492  if (present(berr)) berr = max(accabsdd(0:rmax),bdiff)
493  bacc = max(accabsdd(0:rmax)/norm_dd,bdiff/norm)
494  if (monitoring) pointscntb_dd = pointscntb_dd + 1
495  end if
496 
497  if (mflag) call propagateaccflag_cll(bacc,rmax)
498 
499  end select
500 
501  if (mflag) call propagateerrflag_cll
502 
503  if (monitoring) then
504  pointscntb_cll = pointscntb_cll + 1
505 
506  if(maxval(bacc).gt.reqacc_cll) accpointscntb_cll = accpointscntb_cll + 1
507 
508  if(maxval(bacc).gt.critacc_cll) then
509  critpointscntb_cll = critpointscntb_cll + 1
510  if ( critpointscntb_cll.le.noutcritpointsmax_cll(2) ) then
511  call critpointsout_cll('B_cll',0,maxval(bacc), critpointscntb_cll)
512  if( critpointscntb_cll.eq.noutcritpointsmax_cll(2)) then
513  write(ncpout_cll,*) ' Further output of Critical Points for B_cll suppressed '
514  write(ncpout_cll,*)
515  endif
516  end if
517  end if
518 
519  end if
520 
521 
522  end subroutine b_main_cll
523 
524 
525 
526 
527 
528  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
529  ! subroutine B_arrays_cll(B,Buv,MomInv,masses2,rmax,Berr)
530  !
531  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
532 
533  subroutine b_arrays_cll(B,Buv,MomInv,masses2,rmax,Berr)
534 
535  integer, intent(in) :: rmax
536  double complex, intent(in) :: MomInv(1), masses2(0:1)
537  double complex, intent(out) :: Buv(0:rmax/2,0:rmax)
538  double complex, intent(out) :: B(0:rmax/2,0:rmax)
539  double precision, optional, intent(out) :: Berr(0:rmax)
540  double precision :: Berraux(0:rmax)
541 
542  if (present(berr)) then
543  call b_main_cll(b,buv,mominv(1),masses2(0),masses2(1),rmax,berr)
544  else
545  call b_main_cll(b,buv,mominv(1),masses2(0),masses2(1),rmax,berraux)
546  end if
547 
548  end subroutine b_arrays_cll
549 
550 
551 
552 
553 
554  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
555  ! subroutine B_list_cll(B,Buv,p10,m02,m12,rmax,Berr)
556  !
557  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
558 
559  subroutine b_list_cll(B,Buv,p10,m02,m12,rmax,Berr)
560 
561  integer, intent(in) :: rmax
562  double complex, intent(in) :: p10,m02,m12
563  double complex, intent(out) :: Buv(1:),B(1:)
564  double precision, optional, intent(out) :: Berr(0:rmax)
565  double precision :: Berraux(0:rmax)
566  logical :: eflag
567 
568  if (2.gt.nmax_cll) then
569  call seterrflag_cll(-10)
570  call errout_cll('B_cll','Nmax_cll smaller 2',eflag,.true.)
571  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
572  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 2'
573  call propagateerrflag_cll
574  return
575  end if
576  if (rmax.gt.rmax_cll) then
577  call seterrflag_cll(-10)
578  call errout_cll('B_cll','argument rmax larger than rmax_cll',eflag,.true.)
579  write(nerrout_cll,*) 'rmax =',rmax
580  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
581  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
582  call propagateerrflag_cll
583  return
584  end if
585 
586  call b_list_checked_cll(b,buv,p10,m02,m12,rmax,berr)
587 
588  end subroutine b_list_cll
589 
590 
591  subroutine b_list_checked_cll(B,Buv,p10,m02,m12,rmax,Berr)
592 
593  integer, intent(in) :: rmax
594  double complex, intent(in) :: p10,m02,m12
595  double complex, intent(out) :: Buv(1:NCoefs(rmax,2)),B(1:NCoefs(rmax,2))
596  double precision, optional, intent(out) :: Berr(0:rmax)
597  double complex :: Buv_aux(0:rmax/2,0:rmax), B_aux(0:rmax/2,0:rmax)
598  double precision :: Berraux(0:rmax)
599  integer :: r,n0,n1,cnt
600 
601  if (present(berr)) then
602  call b_main_cll(b_aux,buv_aux,p10,m02,m12,rmax,berr)
603  else
604  call b_main_cll(b_aux,buv_aux,p10,m02,m12,rmax,berraux)
605  end if
606 
607  cnt = 0
608  do r=0,rmax
609  do n0=r/2,0,-1
610  n1 = r-2*n0
611 
612  cnt=cnt+1
613  b(cnt) = b_aux(n0,n1)
614  buv = buv_aux(n0,n1)
615  end do
616  end do
617 
618  end subroutine b_list_checked_cll
619 
620 
621 
622 
623 
624  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
625  ! subroutine B_arrays_list_cll(B,Buv,MomInv,masses2,rmax,Berr)
626  !
627  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
628 
629  subroutine b_arrays_list_cll(B,Buv,MomInv,masses2,rmax,Berr)
630 
631  integer, intent(in) :: rmax
632  double complex, intent(in) :: MomInv(1),masses2(0:1)
633  double precision, optional, intent(out) :: Berr(0:rmax)
634  double complex, intent(out) :: Buv(1:),B(1:)
635  logical :: eflag
636 
637  if (2.gt.nmax_cll) then
638  call seterrflag_cll(-10)
639  call errout_cll('B_cll','Nmax_cll smaller 2',eflag,.true.)
640  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
641  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 2'
642  call propagateerrflag_cll
643  return
644  end if
645  if (rmax.gt.rmax_cll) then
646  call seterrflag_cll(-10)
647  call errout_cll('B_cll','argument rmax larger than rmax_cll',eflag,.true.)
648  write(nerrout_cll,*) 'rmax =',rmax
649  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
650  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
651  call propagateerrflag_cll
652  return
653  end if
654 
655  call b_arrays_list_checked_cll(b,buv,mominv,masses2,rmax,berr)
656 
657  end subroutine b_arrays_list_cll
658 
659 
660  subroutine b_arrays_list_checked_cll(B,Buv,MomInv,masses2,rmax,Berr)
661 
662  integer, intent(in) :: rmax
663  double complex, intent(in) :: MomInv(1),masses2(0:1)
664  double complex, intent(out) :: Buv(1:NCoefs(rmax,2)),B(1:NCoefs(rmax,2))
665  double precision, optional, intent(out) :: Berr(0:rmax)
666  double complex :: Buv_aux(0:rmax/2,0:rmax), B_aux(0:rmax/2,0:rmax)
667  double precision :: Berraux(0:rmax)
668  integer :: r,n0,n1,cnt
669 
670  if (present(berr)) then
671  call b_main_cll(b_aux,buv_aux,mominv(1),masses2(0),masses2(1),rmax,berr)
672  else
673  call b_main_cll(b_aux,buv_aux,mominv(1),masses2(0),masses2(1),rmax,berraux)
674  end if
675 
676  cnt = 0
677  do r=0,rmax
678  do n0=r/2,0,-1
679  n1 = r-2*n0
680 
681  cnt=cnt+1
682  b(cnt) = b_aux(n0,n1)
683  buv = buv_aux(n0,n1)
684  end do
685  end do
686 
687  end subroutine b_arrays_list_checked_cll
688 
689 
690 
691 
692 
693  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
694  ! subroutine C_main_cll(C,Cuv,p10,p21,p20,m02,m12,m22,rmax,Cerr,id_in,Cerr2)
695  !
696  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
697 
698  subroutine c_main_cll(C,Cuv,p10,p21,p20,m02,m12,m22,rmax,Cerr,id_in,Cerr2)
699 
700  integer, intent(in) :: rmax
701  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
702  double precision :: q10,q21,q20
703  double complex :: mm02,mm12,mm22
704  double complex, intent(out) :: Cuv(0:rmax/2,0:rmax,0:rmax)
705  double complex, intent(out) :: C(0:rmax/2,0:rmax,0:rmax)
706  double precision, optional, intent(out) :: Cerr(0:rmax),Cerr2(0:rmax)
707  integer, optional, intent(in) :: id_in
708  double complex :: C2uv(0:rmax/2,0:rmax,0:rmax),C2(0:rmax/2,0:rmax,0:rmax)
709  double complex :: Ccoliuv(0:rmax,0:rmax,0:rmax),Ccoli(0:rmax,0:rmax,0:rmax)
710  double complex :: Cdduv(0:rmax,0:rmax,0:rmax)
711  double complex :: Cdd(0:rmax,0:rmax,0:rmax)
712  double precision :: Cerraux(0:rmax),Cerr2aux(0:rmax)
713  double complex :: elimcminf2
714  double complex args(6)
715  integer :: n0,rank,errflag,id
716  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD)
717  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
718  double precision :: Cacc(0:rmax),norm,norm_coli,norm_dd,Cacc2(0:rmax),Cdiff(0:rmax)
719  integer :: accflagDD,errflagDD,NDD,rankDD
720  logical :: mflag,eflag
721  integer :: r,n1,n2
722 
723  if (3.gt.nmax_cll) then
724  call seterrflag_cll(-10)
725  call errout_cll('C_cll','Nmax_cll smaller 3',eflag,.true.)
726  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
727  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 3'
728  call propagateerrflag_cll
729  return
730  end if
731  if (rmax.gt.rmax_cll) then
732  call seterrflag_cll(-10)
733  call errout_cll('C_cll','argument rmax larger than rmax_cll',eflag,.true.)
734  write(nerrout_cll,*) 'rmax =',rmax
735  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
736  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
737  call propagateerrflag_cll
738  return
739  end if
740 
741  mflag=.true.
742  if (present(id_in)) then
743  mflag=.false.
744  id = id_in
745  else
746  id = 0
747  end if
748 
749 
750  if (mflag) then
751  ! set ID of master call
752  args(1) = p10
753  args(2) = p21
754  args(3) = p20
755  args(4) = m02
756  args(5) = m12
757  args(6) = m22
758  call setmasterfname_cll('C_cll')
759  call setmastern_cll(3)
760  call setmasterr_cll(rmax)
761  call setmasterargs_cll(6,args)
762 
763  call settencache_cll(never_tenred_cll)
764  end if
765 
766 
767  select case (mode_cll)
768 
769  case (1)
770  ! calculate loop integral using
771  ! COLI implementation by AD/LH
772 
773  call calcc(ccoli,ccoliuv,p10,p21,p20,m02,m12,m22,rmax,id,cerraux,cerr2aux)
774 
775  norm = abs(ccoli(0,0,0))
776  do r=1,rmax
777  do n1=0,r
778  n2=r-n1
779  norm = max(norm,abs(ccoli(0,n1,n2)))
780  end do
781  end do
782  if (norm.eq.0d0) then
783  norm = max(abs(p10),abs(p21),abs(p20),abs(m02),abs(m12),abs(m22))
784  if(norm.ne.0d0) then
785  norm=1d0/norm
786  else
787  norm=1d0/muir2_cll
788  end if
789  end if
790 
791  if (norm.ne.0d0) then
792  cacc = cerraux/norm
793  cacc2 = cerr2aux/norm
794  else
795  cacc = 0d0
796  cacc2 = 0d0
797  end if
798 
799  if (present(cerr)) cerr = cerraux
800  if (present(cerr2)) cerr2 = cerr2aux
801 
802  if (mflag) call propagateaccflag_cll(cacc,rmax)
803 
804  c(0:rmax/2,0:rmax,0:rmax) = ccoli(0:rmax/2,0:rmax,0:rmax)
805  cuv(0:rmax/2,0:rmax,0:rmax) = ccoliuv(0:rmax/2,0:rmax,0:rmax)
806 
807 
808  case (2)
809  ! calculate loop integral using
810  ! DD implementation by SD
811 
812  id=0
813 
814  ! replace small masses by DD-identifiers
815  q10 = dreal(getminf2dd_cll(p10))
816  q21 = dreal(getminf2dd_cll(p21))
817  q20 = dreal(getminf2dd_cll(p20))
818  mm02 = getminf2dd_cll(m02)
819  mm12 = getminf2dd_cll(m12)
820  mm22 = getminf2dd_cll(m22)
821 
822  rank = rmax
823  call c_dd(cdd,cdduv,q10,q21,q20,mm02,mm12,mm22,rank,id)
824  c(0:rank/2,0:rank,0:rank) = cdd(0:rank/2,0:rank,0:rank)
825  cuv(0:rank/2,0:rank,0:rank) = cdduv(0:rank/2,0:rank,0:rank)
826 
827  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
828  if(present(cerr)) cerr(0:rmax) = accabsdd(0:rmax)
829  if(present(cerr2)) cerr2(0:rmax) = accabs2dd(0:rmax)
830 
831  norm = abs(c(0,0,0))
832  do r=1,rmax
833  do n1=0,r
834  n2=r-n1
835  norm = max(norm,abs(c(0,n1,n2)))
836  end do
837  end do
838  if (norm.eq.0d0) then
839  norm = max(abs(p10),abs(p21),abs(p20),abs(m02),abs(m12),abs(m22))
840  if(norm.ne.0d0) then
841  norm=1d0/norm
842  else
843  norm=1d0/muir2_cll
844  end if
845  end if
846  if (norm.ne.0d0) then
847  cacc = accabsdd(0:rmax)/norm
848  cacc2 = accabs2dd(0:rmax)/norm
849  else
850  cacc(r) = 0d0
851  cacc2(r) = 0d0
852  end if
853  if (mflag) call propagateaccflag_cll(cacc,rmax)
854 
855 
856  case (3)
857  ! cross-check mode
858  ! compare results for loop integral
859  ! from COLI implementation by AD/LH and
860  ! from DD implementation by SD
861 
862  ! calculate loop integral using COLI
863  call calcc(ccoli,ccoliuv,p10,p21,p20,m02,m12,m22,rmax,id,cerraux,cerr2aux)
864 
865  c(0:rmax/2,0:rmax,0:rmax) = ccoli(0:rmax/2,0:rmax,0:rmax)
866  cuv(0:rmax/2,0:rmax,0:rmax) = ccoliuv(0:rmax/2,0:rmax,0:rmax)
867 
868 
869  ! calculate loop integral using DD
870 
871  id=0
872 
873  ! replace small masses by DD-identifiers
874  q10 = dreal(getminf2dd_cll(p10))
875  q21 = dreal(getminf2dd_cll(p21))
876  q20 = dreal(getminf2dd_cll(p20))
877  mm02 = getminf2dd_cll(m02)
878  mm12 = getminf2dd_cll(m12)
879  mm22 = getminf2dd_cll(m22)
880 
881  rank = rmax
882  call c_dd(cdd,cdduv,q10,q21,q20,mm02,mm12,mm22,rank,id)
883  c2(0:rank/2,0:rank,0:rank) = cdd(0:rank/2,0:rank,0:rank)
884  c2uv(0:rank/2,0:rank,0:rank) = cdduv(0:rank/2,0:rank,0:rank)
885 
886  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
887 
888  ! cross-check
889  norm_coli = abs(c(0,0,0))
890  norm_dd = abs(c2(0,0,0))
891  do r=1,rmax
892  do n1=0,r
893  n2=r-n1
894  norm_coli = max(norm_coli,abs(c(0,n1,n2)))
895  norm_dd = max(norm_dd,abs(c(0,n1,n2)))
896  end do
897  end do
898  if (norm_coli.eq.0d0) then
899  norm_coli = max(abs(p10),abs(p21),abs(p20),abs(m02),abs(m12),abs(m22))
900  if(norm_coli.ne.0d0) then
901  norm_coli=1d0/norm_coli
902  else
903  norm_coli=1d0/muir2_cll
904  end if
905  end if
906  if (norm_dd.eq.0d0) then
907  norm_dd = max(abs(p10),abs(p21),abs(p20),abs(m02),abs(m12),abs(m22))
908  if(norm_dd.ne.0d0) then
909  norm_dd=1d0/norm_dd
910  else
911  norm_dd=1d0/muir2_cll
912  end if
913  end if
914  norm = min(norm_coli,norm_dd)
915 
916  call checkcoefsc_cll(c,c2,p10,p21,p20,m02,m12,m22,rmax,norm,cdiff)
917 
918 
919  if (cerraux(rmax).lt.accabsdd(rmax)) then
920  if (present(cerr)) cerr = max(cerraux,cdiff)
921  if (present(cerr2)) cerr2 = cerr2aux
922  cacc = max(cerraux/norm_coli,cdiff/norm)
923  cacc2 = cerr2aux/norm_coli
924  if (monitoring) pointscntc_coli = pointscntc_coli + 1
925  else
926  c = c2
927  cuv = c2uv
928  if (present(cerr)) cerr = max(accabsdd(0:rmax),cdiff)
929  if (present(cerr2)) cerr2 = accabs2dd(0:rmax)
930  cacc = max(accabsdd(0:rmax)/norm_dd,cdiff/norm)
931  cacc2 = accabs2dd(0:rmax)/norm_dd
932  if (monitoring) pointscntc_dd = pointscntc_dd + 1
933  end if
934 
935  if (mflag) call propagateaccflag_cll(cacc,rmax)
936 
937  end select
938 
939  if (mflag) call propagateerrflag_cll
940 
941  if (monitoring) then
942  pointscntc_cll = pointscntc_cll + 1
943 
944  if(maxval(cacc).gt.reqacc_cll) accpointscntc_cll = accpointscntc_cll + 1
945 
946  if(maxval(cacc).gt.critacc_cll) then
947  critpointscntc_cll = critpointscntc_cll + 1
948  if ( critpointscntc_cll.le.noutcritpointsmax_cll(3) ) then
949  call critpointsout_cll('C_cll',0,maxval(cacc), critpointscntc_cll)
950  if( critpointscntc_cll.eq.noutcritpointsmax_cll(3)) then
951  write(ncpout_cll,*) ' Further output of Critical Points for C_cll suppressed '
952  write(ncpout_cll,*)
953  endif
954  end if
955 
956 ! write(ncpout_cll,*) 'Cerr_coli =',Cerraux
957 ! write(ncpout_cll,*) 'Cerr_dd =',accabsDD(0:rmax)
958 ! write(ncpout_cll,*) 'norm_coli =',norm_coli
959 ! write(ncpout_cll,*) 'norm_dd =',norm_dd
960 ! write(ncpout_cll,*) 'Cacc_coli =',Cerraux/norm_coli
961 ! write(ncpout_cll,*) 'Cacc_dd =',accabsDD(0:rmax)/norm_dd
962 ! write(ncpout_cll,*) 'Cdiff =',Cdiff
963 ! write(ncpout_cll,*) 'norm =',norm
964 ! write(ncpout_cll,*) 'Caccdiff =',Cdiff/norm
965 !
966 ! write(ncpout_cll,*) 'Cacc =',Cacc
967 ! write(ncpout_cll,*) 'Cacc =',Cerraux(rmax).lt.accabsDD(rmax)
968 !
969 
970  end if
971 
972 #ifdef CritPoints2
973  if(maxval(cacc2).gt.reqacc_cll) accpointscntc2_cll = accpointscntc2_cll + 1
974 
975  if(maxval(cacc2).gt.critacc_cll) then
976  critpointscntc2_cll = critpointscntc2_cll + 1
977  if ( critpointscntc2_cll.le.noutcritpointsmax_cll(3) ) then
978  call critpointsout2_cll('C_cll',0,maxval(cacc2), critpointscntc2_cll)
979  if( critpointscntc2_cll.eq.noutcritpointsmax_cll(3)) then
980  write(ncpout2_cll,*) ' Further output of Critical Points for C_cll suppressed '
981  write(ncpout2_cll,*)
982  endif
983  end if
984  end if
985 #endif
986 
987  end if
988 
989 
990  end subroutine c_main_cll
991 
992 
993 
994 
995 
996  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
997  ! subroutine C_arrays_cll(C,Cuv,MomInv,masses2,rmax,Cerr,Cerr2)
998  !
999  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1000 
1001  subroutine c_arrays_cll(C,Cuv,MomInv,masses2,rmax,Cerr,Cerr2)
1002 
1003  integer, intent(in) :: rmax
1004  double complex, intent(in) :: MomInv(3), masses2(0:2)
1005  double complex, intent(out) :: Cuv(0:rmax/2,0:rmax,0:rmax)
1006  double complex, intent(out) :: C(0:rmax/2,0:rmax,0:rmax)
1007  double precision, optional, intent(out) :: Cerr(0:rmax),Cerr2(0:rmax)
1008  double precision :: Cerraux(0:rmax),Cerr2aux(0:rmax)
1009 
1010  if (present(cerr)) then
1011  if (present(cerr2)) then
1012  call c_main_cll(c,cuv,mominv(1),mominv(2),mominv(3), &
1013  masses2(0),masses2(1),masses2(2),rmax,cerr,cerr2=cerr2)
1014  else
1015  call c_main_cll(c,cuv,mominv(1),mominv(2),mominv(3), &
1016  masses2(0),masses2(1),masses2(2),rmax,cerr,cerr2=cerr2aux)
1017  end if
1018  else
1019  if (present(cerr2)) then
1020  call c_main_cll(c,cuv,mominv(1),mominv(2),mominv(3), &
1021  masses2(0),masses2(1),masses2(2),rmax,cerraux,cerr2=cerr2)
1022  else
1023  call c_main_cll(c,cuv,mominv(1),mominv(2),mominv(3), &
1024  masses2(0),masses2(1),masses2(2),rmax,cerraux,cerr2=cerr2aux)
1025  end if
1026  end if
1027 
1028  end subroutine c_arrays_cll
1029 
1030 
1031 
1032 
1033 
1034  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1035  ! subroutine C_list_cll(C,Cuv,MomInv,masses2,rmax,Cerr,Cerr2)
1036  !
1037  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1038 
1039  subroutine c_list_cll(C,Cuv,p10,p21,p20,m02,m12,m22,rmax,Cerr,Cerr2)
1040 
1041  integer, intent(in) :: rmax
1042  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
1043  double complex, intent(out) :: Cuv(:),C(:)
1044  double precision, optional, intent(out) :: Cerr(0:rmax),Cerr2(0:rmax)
1045  logical :: eflag
1046 
1047  if (3.gt.nmax_cll) then
1048  call seterrflag_cll(-10)
1049  call errout_cll('C_cll','Nmax_cll smaller 3',eflag,.true.)
1050  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1051  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 3'
1052  call propagateerrflag_cll
1053  return
1054  end if
1055  if (rmax.gt.rmax_cll) then
1056  call seterrflag_cll(-10)
1057  call errout_cll('C_cll','argument rmax larger than rmax_cll',eflag,.true.)
1058  write(nerrout_cll,*) 'rmax =',rmax
1059  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1060  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1061  call propagateerrflag_cll
1062  return
1063  end if
1064 
1065  call c_list_checked_cll(c,cuv,p10,p21,p20,m02,m12,m22,rmax,cerr,cerr2)
1066 
1067  end subroutine c_list_cll
1068 
1069 
1070  subroutine c_list_checked_cll(C,Cuv,p10,p21,p20,m02,m12,m22,rmax,Cerr,Cerr2)
1071 
1072  integer, intent(in) :: rmax
1073  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
1074  double precision, optional, intent(out) :: Cerr(0:rmax),Cerr2(0:rmax)
1075  double complex, intent(out) :: Cuv(NCoefs(rmax,3)),C(NCoefs(rmax,3))
1076  double complex :: Cuv_aux(0:rmax/2,0:rmax,0:rmax)
1077  double complex :: C_aux(0:rmax/2,0:rmax,0:rmax)
1078  double precision :: Cerraux(0:rmax),Cerr2aux(0:rmax)
1079  integer :: r,n0,n1,n2,cnt
1080  logical :: eflag
1081 
1082  if (present(cerr)) then
1083  if (present(cerr2)) then
1084  call c_main_cll(c_aux,cuv_aux,p10,p21,p20, &
1085  m02,m12,m22,rmax,cerr,cerr2=cerr2)
1086  else
1087  call c_main_cll(c_aux,cuv_aux,p10,p21,p20, &
1088  m02,m12,m22,rmax,cerr,cerr2=cerr2aux)
1089  end if
1090  else
1091  if (present(cerr2)) then
1092  call c_main_cll(c_aux,cuv_aux,p10,p21,p20, &
1093  m02,m12,m22,rmax,cerraux,cerr2=cerr2)
1094  else
1095  call c_main_cll(c_aux,cuv_aux,p10,p21,p20, &
1096  m02,m12,m22,rmax,cerraux,cerr2=cerr2aux)
1097  end if
1098  end if
1099 
1100  cnt = 0
1101  do r=0,rmax
1102  do n0=r/2,0,-1
1103  do n1=r-2*n0,0,-1
1104  n2=r-2*n0-n1
1105 
1106  cnt=cnt+1
1107  c(cnt) = c_aux(n0,n1,n2)
1108  cuv(cnt) = cuv_aux(n0,n1,n2)
1109 
1110  end do
1111  end do
1112  end do
1113 
1114  end subroutine c_list_checked_cll
1115 
1116 
1117 
1118 
1119 
1120  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1121  ! subroutine C_arrays_list_cll(C,Cuv,MomInv,masses2,rmax,Cerr,Cerr2)
1122  !
1123  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1124 
1125  subroutine c_arrays_list_cll(C,Cuv,MomInv,masses2,rmax,Cerr,Cerr2)
1126 
1127  integer, intent(in) :: rmax
1128  double complex, intent(in) :: MomInv(3), masses2(0:2)
1129  double complex, intent(out) :: Cuv(:),C(:)
1130  double precision, optional, intent(out) :: Cerr(0:rmax),Cerr2(0:rmax)
1131  logical :: eflag
1132 
1133  if (3.gt.nmax_cll) then
1134  call seterrflag_cll(-10)
1135  call errout_cll('C_cll','Nmax_cll smaller 3',eflag,.true.)
1136  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1137  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 3'
1138  call propagateerrflag_cll
1139  return
1140  end if
1141  if (rmax.gt.rmax_cll) then
1142  call seterrflag_cll(-10)
1143  call errout_cll('C_cll','argument rmax larger than rmax_cll',eflag,.true.)
1144  write(nerrout_cll,*) 'rmax =',rmax
1145  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1146  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1147  call propagateerrflag_cll
1148  return
1149  end if
1150 
1151  call c_arrays_list_checked_cll(c,cuv,mominv,masses2,rmax,cerr,cerr2)
1152 
1153  end subroutine c_arrays_list_cll
1154 
1155 
1156  subroutine c_arrays_list_checked_cll(C,Cuv,MomInv,masses2,rmax,Cerr,Cerr2)
1157 
1158  integer, intent(in) :: rmax
1159  double complex, intent(in) :: MomInv(3), masses2(0:2)
1160  double complex, intent(out) :: Cuv(NCoefs(rmax,3)),C(NCoefs(rmax,3))
1161  double precision, optional, intent(out) :: Cerr(0:rmax),Cerr2(0:rmax)
1162  double complex :: Cuv_aux(0:rmax/2,0:rmax,0:rmax)
1163  double complex :: C_aux(0:rmax/2,0:rmax,0:rmax)
1164  double precision :: Cerraux(0:rmax),Cerr2aux(0:rmax)
1165  integer :: r,n0,n1,n2,cnt
1166 
1167  if (present(cerr)) then
1168  if (present(cerr2)) then
1169  call c_main_cll(c_aux,cuv_aux,mominv(1),mominv(2),mominv(3), &
1170  masses2(0),masses2(1),masses2(2),rmax,cerr,cerr2=cerr2)
1171  else
1172  call c_main_cll(c_aux,cuv_aux,mominv(1),mominv(2),mominv(3), &
1173  masses2(0),masses2(1),masses2(2),rmax,cerr,cerr2=cerr2aux)
1174  end if
1175  else
1176  if (present(cerr2)) then
1177  call c_main_cll(c_aux,cuv_aux,mominv(1),mominv(2),mominv(3), &
1178  masses2(0),masses2(1),masses2(2),rmax,cerraux,cerr2=cerr2)
1179  else
1180  call c_main_cll(c_aux,cuv_aux,mominv(1),mominv(2),mominv(3), &
1181  masses2(0),masses2(1),masses2(2),rmax,cerraux,cerr2=cerr2aux)
1182  end if
1183  end if
1184 
1185  cnt = 0
1186  do r=0,rmax
1187  do n0=r/2,0,-1
1188  do n1=r-2*n0,0,-1
1189  n2=r-2*n0-n1
1190 
1191  cnt=cnt+1
1192  c(cnt) = c_aux(n0,n1,n2)
1193  cuv(cnt) = cuv_aux(n0,n1,n2)
1194 
1195  end do
1196  end do
1197  end do
1198 
1199  end subroutine c_arrays_list_checked_cll
1200 
1201 
1202 
1203 
1204 
1205  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1206  ! subroutine D_main_cll(D,Duv,p10,p21,p32,p30,p20,p31, &
1207  ! m02,m12,m22,m32,rmax,Derr,id_in,Derr2)
1208  !
1209  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1210 
1211  subroutine d_main_cll(D,Duv,p10,p21,p32,p30,p20,p31, &
1212  m02,m12,m22,m32,rmax,Derr,id_in,Derr2)
1213 
1214  integer, intent(in) :: rmax
1215  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
1216  double precision :: q10,q21,q32,q30,q20,q31
1217  double complex :: mm02,mm12,mm22,mm32
1218  double complex, intent(out) :: D(0:rmax/2,0:rmax,0:rmax,0:rmax)
1219  double complex, intent(out) :: Duv(0:rmax/2,0:rmax,0:rmax,0:rmax)
1220  double precision, optional, intent(out) :: Derr(0:rmax),Derr2(0:rmax)
1221  integer, optional, intent(in) :: id_in
1222  double complex :: D2uv(0:rmax/2,0:rmax,0:rmax,0:rmax)
1223  double complex :: D2(0:rmax/2,0:rmax,0:rmax,0:rmax)
1224  double complex :: Dcoliuv(0:rmax,0:rmax,0:rmax,0:rmax)
1225  double complex :: Dcoli(0:rmax,0:rmax,0:rmax,0:rmax)
1226  double complex :: Ddduv(0:rmax,0:rmax,0:rmax,0:rmax)
1227  double complex :: Ddd(0:rmax,0:rmax,0:rmax,0:rmax)
1228  double precision :: Derraux(0:rmax),Derr2aux(0:rmax),Ddiff(0:rmax)
1229  double complex :: elimcminf2
1230  double complex :: args(10)
1231  integer :: n0,rank,errflag,id
1232  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD),Dacc(0:rmax),norm,norm_coli,norm_dd,Dacc2(0:rmax)
1233  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
1234  integer :: accflagDD,errflagDD,NDD,rankDD
1235  logical :: mflag,eflag
1236  integer :: r,n1,n2,n3
1237 
1238  if (4.gt.nmax_cll) then
1239  call seterrflag_cll(-10)
1240  call errout_cll('D_cll','Nmax_cll smaller 4',eflag,.true.)
1241  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1242  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
1243  call propagateerrflag_cll
1244  return
1245  end if
1246  if (rmax.gt.rmax_cll) then
1247  call seterrflag_cll(-10)
1248  call errout_cll('D_cll','argument rmax larger than rmax_cll',eflag,.true.)
1249  write(nerrout_cll,*) 'rmax =',rmax
1250  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1251  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1252  call propagateerrflag_cll
1253  return
1254  end if
1255 
1256  mflag=.true.
1257  if (present(id_in)) then
1258  mflag=.false.
1259  id = id_in
1260  else
1261  id = 0
1262  end if
1263 
1264  if (mflag) then
1265  ! set ID of master call
1266  args(1) = p10
1267  args(2) = p21
1268  args(3) = p32
1269  args(4) = p30
1270  args(5) = p20
1271  args(6) = p31
1272  args(7) = m02
1273  args(8) = m12
1274  args(9) = m22
1275  args(10) = m32
1276  call setmasterfname_cll('D_cll')
1277  call setmastern_cll(4)
1278  call setmasterr_cll(rmax)
1279  call setmasterargs_cll(10,args)
1280 
1281  call settencache_cll(never_tenred_cll)
1282  end if
1283 
1284 
1285  select case (mode_cll)
1286 
1287  case (1)
1288  ! calculate loop integral using
1289  ! COLI implementation by AD/LH
1290 
1291  call calcd(dcoli,dcoliuv,p10,p21,p32,p30,p20,p31, &
1292  m02,m12,m22,m32,rmax,id,derraux,derr2aux)
1293 
1294  norm = abs(dcoli(0,0,0,0))
1295  do r=1,rmax
1296  do n1=0,r
1297  do n2=0,r-n1
1298  n3=r-n1-n2
1299  norm = max(norm,abs(dcoli(0,n1,n2,n3)))
1300  end do
1301  end do
1302  end do
1303  if (norm.eq.0d0) then
1304  norm = max(abs(p10),abs(p21),abs(p32),abs(p30),abs(p20),abs(p31), &
1305  abs(m02),abs(m12),abs(m22),abs(m32))
1306  if(norm.ne.0d0) then
1307  norm=1d0/norm**2
1308  else
1309  norm=1d0/muir2_cll**2
1310  end if
1311  end if
1312  if (norm.ne.0d0) then
1313  dacc = derraux/norm
1314  dacc2 = derr2aux/norm
1315  else
1316  dacc = 0d0
1317  dacc2 = 0d0
1318  end if
1319 
1320  if (present(derr)) derr = derraux
1321  if (present(derr2)) derr2 = derr2aux
1322 
1323  if (mflag) call propagateaccflag_cll(dacc,rmax)
1324 
1325  d(0:rmax/2,0:rmax,0:rmax,0:rmax) = dcoli(0:rmax/2,0:rmax,0:rmax,0:rmax)
1326  duv(0:rmax/2,0:rmax,0:rmax,0:rmax) = dcoliuv(0:rmax/2,0:rmax,0:rmax,0:rmax)
1327 
1328 
1329  case (2)
1330  ! calculate loop integral using
1331  ! DD implementation by SD
1332 
1333  id=0
1334 
1335  ! replace small masses by DD-identifiers
1336  q10 = dreal(getminf2dd_cll(p10))
1337  q21 = dreal(getminf2dd_cll(p21))
1338  q32 = dreal(getminf2dd_cll(p32))
1339  q30 = dreal(getminf2dd_cll(p30))
1340  q20 = dreal(getminf2dd_cll(p20))
1341  q31 = dreal(getminf2dd_cll(p31))
1342  mm02 = getminf2dd_cll(m02)
1343  mm12 = getminf2dd_cll(m12)
1344  mm22 = getminf2dd_cll(m22)
1345  mm32 = getminf2dd_cll(m32)
1346 
1347  rank = rmax
1348 ! write(*,*) rank
1349 ! write(*,*) q10,q21
1350 ! write(*,*) q32,q30
1351 ! write(*,*) q20,q31
1352 ! write(*,*) mm02,mm12
1353 ! write(*,*) mm22,mm32
1354  call d_dd(ddd,ddduv,q10,q21,q32,q30,q20,q31, &
1355  mm02,mm12,mm22,mm32,rank,id)
1356  d(0:rank/2,0:rank,0:rank,0:rank) = ddd(0:rank/2,0:rank,0:rank,0:rank)
1357  duv(0:rank/2,0:rank,0:rank,0:rank) = ddduv(0:rank/2,0:rank,0:rank,0:rank)
1358 
1359  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
1360  if (present(derr)) derr(0:rmax) = accabsdd(0:rmax)
1361  if (present(derr2)) derr2(0:rmax) = accabs2dd(0:rmax)
1362 
1363  norm = abs(d(0,0,0,0))
1364  do r=1,rmax
1365  do n1=0,r
1366  do n2=0,r-n1
1367  n3=r-n1-n2
1368  norm = max(norm,abs(d(0,n1,n2,n3)))
1369  end do
1370  end do
1371  end do
1372  if (norm.eq.0d0) then
1373  norm = max(abs(p10),abs(p21),abs(p32),abs(p30),abs(p20),abs(p31), &
1374  abs(m02),abs(m12),abs(m22),abs(m32))
1375  if(norm.ne.0d0) then
1376  norm=1d0/norm**2
1377  else
1378  norm=1d0/muir2_cll**2
1379  end if
1380  end if
1381  if (norm.ne.0d0) then
1382  dacc = accabsdd(0:rmax)/norm
1383  dacc2 = accabs2dd(0:rmax)/norm
1384  else
1385  dacc = 0d0
1386  dacc2 = 0d0
1387  end if
1388  if (mflag) call propagateaccflag_cll(dacc,rmax)
1389 
1390 
1391  case (3)
1392  ! cross-check mode
1393  ! compare results for loop integral
1394  ! from COLI implementation by AD/LH and
1395  ! from DD implementation by SD
1396 
1397  ! calculate loop integral using COLI
1398  call calcd(dcoli,dcoliuv,p10,p21,p32,p30,p20,p31, &
1399  m02,m12,m22,m32,rmax,id,derraux,derr2aux)
1400 
1401  d(0:rmax/2,0:rmax,0:rmax,0:rmax) = dcoli(0:rmax/2,0:rmax,0:rmax,0:rmax)
1402  duv(0:rmax/2,0:rmax,0:rmax,0:rmax) = dcoliuv(0:rmax/2,0:rmax,0:rmax,0:rmax)
1403 
1404 
1405  ! calculate loop integral using DD
1406 
1407  id=0
1408 
1409  ! replace small masses by DD-identifiers
1410  q10 = dreal(getminf2dd_cll(p10))
1411  q21 = dreal(getminf2dd_cll(p21))
1412  q32 = dreal(getminf2dd_cll(p32))
1413  q30 = dreal(getminf2dd_cll(p30))
1414  q20 = dreal(getminf2dd_cll(p20))
1415  q31 = dreal(getminf2dd_cll(p31))
1416  mm02 = getminf2dd_cll(m02)
1417  mm12 = getminf2dd_cll(m12)
1418  mm22 = getminf2dd_cll(m22)
1419  mm32 = getminf2dd_cll(m32)
1420 
1421  rank = rmax
1422  call d_dd(ddd,ddduv,q10,q21,q32,q30,q20,q31, &
1423  mm02,mm12,mm22,mm32,rank,id)
1424  do n0=0,rank/2
1425  d2(n0,0:rank,0:rank,0:rank) = ddd(n0,0:rank,0:rank,0:rank)
1426  d2uv(n0,0:rank,0:rank,0:rank) = ddduv(n0,0:rank,0:rank,0:rank)
1427  end do
1428  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
1429 
1430  norm_coli = abs(d(0,0,0,0))
1431  norm_dd = abs(d2(0,0,0,0))
1432  do r=1,rmax
1433  do n1=0,r
1434  do n2=0,r-n1
1435  n3=r-n1-n2
1436  norm_coli = max(norm_coli,abs(d(0,n1,n2,n3)))
1437  norm_dd = max(norm_dd,abs(d2(0,n1,n2,n3)))
1438  end do
1439  end do
1440  end do
1441  if (norm_coli.eq.0d0) then
1442  norm_coli = max(abs(p10),abs(p21),abs(p32),abs(p30),abs(p20),abs(p31), &
1443  abs(m02),abs(m12),abs(m22),abs(m32))
1444  if(norm_coli.ne.0d0) then
1445  norm_coli=1d0/norm_coli**2
1446  else
1447  norm_coli=1d0/muir2_cll**2
1448  end if
1449  end if
1450  if (norm_dd.eq.0d0) then
1451  norm_dd = max(abs(p10),abs(p21),abs(p32),abs(p30),abs(p20),abs(p31), &
1452  abs(m02),abs(m12),abs(m22),abs(m32))
1453  if(norm_dd.ne.0d0) then
1454  norm_dd=1d0/norm_dd**2
1455  else
1456  norm_dd=1d0/muir2_cll**2
1457  end if
1458  end if
1459  norm = min(norm_coli,norm_dd)
1460 
1461  ! cross-check
1462  call checkcoefsd_cll(d,d2,p10,p21,p32,p30,p20,p31, &
1463  m02,m12,m22,m32,rmax,norm,ddiff)
1464 
1465 
1466  if (derraux(rmax).lt.accabsdd(rmax)) then
1467  if (present(derr)) derr = max(derraux,ddiff)
1468  if (present(derr2)) derr2 = derr2aux
1469  if (norm.ne.0d0) then
1470  dacc = max(derraux/norm_coli,ddiff/norm)
1471  dacc2 = derr2aux/norm_coli
1472  else
1473  dacc = ddiff
1474  dacc2 = 0d0
1475  end if
1476  if (monitoring) pointscntd_coli = pointscntd_coli + 1
1477  else
1478  d = d2
1479  duv = d2uv
1480  if (present(derr)) derr = max(accabsdd(0:rmax),ddiff)
1481  if (present(derr2)) derr2 = accabs2dd(0:rmax)
1482  if (norm.ne.0d0) then
1483  dacc = max(accabsdd(0:rmax)/norm_dd,ddiff/norm)
1484  dacc2 = accabs2dd(0:rmax)/norm_dd
1485  else
1486  dacc = ddiff
1487  dacc2 = 0d0
1488  end if
1489  if (monitoring) pointscntd_dd = pointscntd_dd + 1
1490  end if
1491 
1492  if (mflag) call propagateaccflag_cll(dacc,rmax)
1493 
1494  end select
1495 
1496  if (mflag) call propagateerrflag_cll
1497 
1498  if (monitoring) then
1499  pointscntd_cll = pointscntd_cll + 1
1500 
1501  if(maxval(dacc).gt.reqacc_cll) accpointscntd_cll = accpointscntd_cll + 1
1502 
1503  if(maxval(dacc).gt.critacc_cll) then
1504  critpointscntd_cll = critpointscntd_cll + 1
1505  if ( critpointscntd_cll.le.noutcritpointsmax_cll(4) ) then
1506  call critpointsout_cll('D_cll',0,maxval(dacc), critpointscntd_cll)
1507  if( critpointscntd_cll.eq.noutcritpointsmax_cll(4)) then
1508  write(ncpout_cll,*) ' Further output of Critical Points for D_cll suppressed '
1509  write(ncpout_cll,*)
1510  endif
1511  end if
1512  end if
1513 
1514 
1515 #ifdef CritPoints2
1516  if(maxval(dacc2).gt.reqacc_cll) accpointscntd2_cll = accpointscntd2_cll + 1
1517 
1518  if(maxval(dacc2).gt.critacc_cll) then
1519  critpointscntd2_cll = critpointscntd2_cll + 1
1520  if ( critpointscntd2_cll.le.noutcritpointsmax_cll(4) ) then
1521  call critpointsout2_cll('D_cll',0,maxval(dacc2), critpointscntd2_cll)
1522  if( critpointscntd2_cll.eq.noutcritpointsmax_cll(4)) then
1523  write(ncpout2_cll,*) ' Further output of Critical Points for D_cll suppressed '
1524  write(ncpout2_cll,*)
1525  endif
1526  end if
1527  end if
1528 #endif
1529 
1530  end if
1531 
1532 
1533  end subroutine d_main_cll
1534 
1535 
1536 
1537 
1538 
1539  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1540  ! subroutine D_arrays_cll(D,Duv,MomInv,masses2,rmax,Derr,Derr2)
1541  !
1542  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1543 
1544  subroutine d_arrays_cll(D,Duv,MomInv,masses2,rmax,Derr,Derr2)
1545 
1546  integer, intent(in) :: rmax
1547  double complex, intent(in) :: MomInv(6), masses2(0:3)
1548  double complex, intent(out) :: D(0:rmax/2,0:rmax,0:rmax,0:rmax)
1549  double complex, intent(out) :: Duv(0:rmax/2,0:rmax,0:rmax,0:rmax)
1550  double precision, optional, intent(out) :: Derr(0:rmax),Derr2(0:rmax)
1551  double precision :: Derraux(0:rmax),Derr2aux(0:rmax)
1552 
1553  logical :: eflag
1554 
1555  if (4.gt.nmax_cll) then
1556  call seterrflag_cll(-10)
1557  call errout_cll('D_cll','Nmax_cll smaller 4',eflag,.true.)
1558  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1559  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
1560  call propagateerrflag_cll
1561  return
1562  end if
1563  if (rmax.gt.rmax_cll) then
1564  call seterrflag_cll(-10)
1565  call errout_cll('D_cll','argument rmax larger than rmax_cll',eflag,.true.)
1566  write(nerrout_cll,*) 'rmax =',rmax
1567  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1568  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1569  call propagateerrflag_cll
1570  return
1571  end if
1572 
1573  if (present(derr)) then
1574  if (present(derr2)) then
1575  call d_main_cll(d,duv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1576  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr,derr2=derr2)
1577  else
1578  call d_main_cll(d,duv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1579  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr)
1580  end if
1581  else
1582  if (present(derr2)) then
1583  call d_main_cll(d,duv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1584  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derraux,derr2=derr2)
1585  else
1586  call d_main_cll(d,duv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1587  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derraux)
1588  end if
1589  end if
1590 
1591  end subroutine d_arrays_cll
1592 
1593 
1594 
1595 
1596 
1597  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1598  ! subroutine D_list_cll(D,Duv,p10,p21,p32,p30,p20,p31,m02,m12,m22,m32,rmax,Derr,Derr2)
1599  !
1600  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1601 
1602  subroutine d_list_cll(D,Duv,p10,p21,p32,p30,p20,p31,m02,m12,m22,m32,rmax,Derr,Derr2)
1603 
1604  integer, intent(in) :: rmax
1605  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
1606  double complex, intent(out) :: D(:),Duv(:)
1607  double precision, optional, intent(out) :: Derr(0:rmax),Derr2(0:rmax)
1608  logical :: eflag
1609 
1610  if (4.gt.nmax_cll) then
1611  call seterrflag_cll(-10)
1612  call errout_cll('D_cll','Nmax_cll smaller 4',eflag,.true.)
1613  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1614  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
1615  call propagateerrflag_cll
1616  return
1617  end if
1618  if (rmax.gt.rmax_cll) then
1619  call seterrflag_cll(-10)
1620  call errout_cll('D_cll','argument rmax larger than rmax_cll',eflag,.true.)
1621  write(nerrout_cll,*) 'rmax =',rmax
1622  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1623  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1624  call propagateerrflag_cll
1625  return
1626  end if
1627 
1628  call d_list_checked_cll(d,duv,p10,p21,p32,p30,p20,p31, &
1629  m02,m12,m22,m32,rmax,derr,derr2)
1630 
1631  end subroutine d_list_cll
1632 
1633 
1634  subroutine d_list_checked_cll(D,Duv,p10,p21,p32,p30,p20,p31,m02,m12,m22,m32,rmax,Derr,Derr2)
1635 
1636  integer, intent(in) :: rmax
1637  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
1638  double complex, intent(out) :: D(NCoefs(rmax,4)),Duv(NCoefs(rmax,4))
1639  double precision, optional, intent(out) :: Derr(0:rmax),Derr2(0:rmax)
1640  double complex :: D_aux(0:rmax/2,0:rmax,0:rmax,0:rmax)
1641  double complex :: Duv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax)
1642  double precision :: Derraux(0:rmax),Derr2aux(0:rmax)
1643  integer :: r,n0,n1,n2,n3,cnt
1644 
1645  if (present(derr)) then
1646  if (present(derr2)) then
1647  call d_main_cll(d_aux,duv_aux,p10,p21,p32,p30,p20,p31, &
1648  m02,m12,m22,m32,rmax,derr,derr2=derr2)
1649  else
1650  call d_main_cll(d_aux,duv_aux,p10,p21,p32,p30,p20,p31, &
1651  m02,m12,m22,m32,rmax,derr)
1652  end if
1653  else
1654  if (present(derr2)) then
1655  call d_main_cll(d_aux,duv_aux,p10,p21,p32,p30,p20,p31, &
1656  m02,m12,m22,m32,rmax,derraux,derr2=derr2)
1657  else
1658  call d_main_cll(d_aux,duv_aux,p10,p21,p32,p30,p20,p31, &
1659  m02,m12,m22,m32,rmax,derraux)
1660  end if
1661  end if
1662 
1663  cnt=0
1664  do r=0,rmax
1665  do n0=r/2,0,-1
1666  do n1=r-2*n0,0,-1
1667  do n2=r-2*n0-n1,0,-1
1668  n3=r-2*n0-n1-n2
1669 
1670  cnt=cnt+1
1671  d(cnt) = d_aux(n0,n1,n2,n3)
1672  duv(cnt) = duv_aux(n0,n1,n2,n3)
1673 
1674  end do
1675  end do
1676  end do
1677  end do
1678 
1679  end subroutine d_list_checked_cll
1680 
1681 
1682 
1683 
1684 
1685  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1686  ! subroutine D_arrays_list_cll(D,Duv,MomInv,masses2,rmax,Derr,Derr2)
1687  !
1688  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1689 
1690  subroutine d_arrays_list_cll(D,Duv,MomInv,masses2,rmax,Derr,Derr2)
1691 
1692  integer, intent(in) :: rmax
1693  double complex, intent(in) :: MomInv(6), masses2(0:3)
1694  double complex, intent(out) :: D(:),Duv(:)
1695  double precision, optional, intent(out) :: Derr(0:rmax),Derr2(0:rmax)
1696  logical :: eflag
1697 
1698  if (4.gt.nmax_cll) then
1699  call seterrflag_cll(-10)
1700  call errout_cll('D_cll','Nmax_cll smaller 4',eflag,.true.)
1701  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1702  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
1703  call propagateerrflag_cll
1704  return
1705  end if
1706  if (rmax.gt.rmax_cll) then
1707  call seterrflag_cll(-10)
1708  call errout_cll('D_cll','argument rmax larger than rmax_cll',eflag,.true.)
1709  write(nerrout_cll,*) 'rmax =',rmax
1710  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1711  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1712  call propagateerrflag_cll
1713  return
1714  end if
1715 
1716  call d_arrays_list_checked_cll(d,duv,mominv,masses2,rmax,derr,derr2)
1717 
1718  end subroutine d_arrays_list_cll
1719 
1720 
1721  subroutine d_arrays_list_checked_cll(D,Duv,MomInv,masses2,rmax,Derr,Derr2)
1722 
1723  integer, intent(in) :: rmax
1724  double complex, intent(in) :: MomInv(6), masses2(0:3)
1725  double complex, intent(out) :: D(NCoefs(rmax,4)),Duv(NCoefs(rmax,4))
1726  double precision, optional, intent(out) :: Derr(0:rmax),Derr2(0:rmax)
1727  double complex :: D_aux(0:rmax/2,0:rmax,0:rmax,0:rmax)
1728  double complex :: Duv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax)
1729  double precision :: Derraux(0:rmax),Derr2aux(0:rmax)
1730  integer :: r,n0,n1,n2,n3,cnt
1731 
1732  if (present(derr)) then
1733  if (present(derr2)) then
1734  call d_main_cll(d_aux,duv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1735  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr,derr2=derr2)
1736  else
1737  call d_main_cll(d_aux,duv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1738  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr)
1739  end if
1740  else
1741  if (present(derr2)) then
1742  call d_main_cll(d_aux,duv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1743  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derraux,derr2=derr2)
1744  else
1745  call d_main_cll(d_aux,duv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
1746  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derraux)
1747  end if
1748  end if
1749 
1750  cnt=0
1751  do r=0,rmax
1752  do n0=r/2,0,-1
1753  do n1=r-2*n0,0,-1
1754  do n2=r-2*n0-n1,0,-1
1755  n3=r-2*n0-n1-n2
1756 
1757  cnt=cnt+1
1758  d(cnt) = d_aux(n0,n1,n2,n3)
1759  duv(cnt) = duv_aux(n0,n1,n2,n3)
1760 
1761  end do
1762  end do
1763  end do
1764  end do
1765 
1766  end subroutine d_arrays_list_checked_cll
1767 
1768 
1769 
1770 
1771 
1772  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1773  ! subroutine E_main_cll(E,Euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
1774  ! m02,m12,m22,m32,m42,rmax,Eerr,id_in,Eerr2)
1775  !
1776  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1777 
1778  subroutine e_main_cll(E,Euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
1779  m02,m12,m22,m32,m42,rmax,Eerr,id_in,Eerr2)
1780 
1781  integer, intent(in) :: rmax
1782  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
1783  double complex, intent(in) :: m02,m12,m22,m32,m42
1784  double complex, intent(out) :: E(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1785  double complex, intent(out) :: Euv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1786  double precision, optional, intent(out) :: Eerr(0:rmax),Eerr2(0:rmax)
1787  double precision :: q10,q21,q32,q43,q40,q20,q31,q42,q30,q41
1788  double complex :: mm02,mm12,mm22,mm32,mm42
1789  double precision :: Eerraux(0:rmax),Eerr2aux(0:rmax),Ediff(0:rmax)
1790  integer, optional, intent(in) :: id_in
1791  double complex :: E2uv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1792  double complex :: E2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1793  double complex :: Edd(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1794  double complex :: elimcminf2
1795  double complex :: args(15)
1796  integer :: n0,rank,errflag,id
1797  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD),Eacc(0:rmax),norm,norm_coli,norm_dd,Eacc2(0:rmax)
1798  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
1799  integer :: accflagDD,errflagDD,NDD,rankDD
1800  logical :: mflag,eflag
1801  integer :: r,n1,n2,n3,n4
1802 
1803  if (5.gt.nmax_cll) then
1804  call seterrflag_cll(-10)
1805  call errout_cll('E_cll','Nmax_cll smaller 5',eflag,.true.)
1806  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1807  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 5'
1808  call propagateerrflag_cll
1809  return
1810  end if
1811  if (rmax.gt.rmax_cll) then
1812  call seterrflag_cll(-10)
1813  call errout_cll('E_cll','argument rmax larger than rmax_cll',eflag,.true.)
1814  write(nerrout_cll,*) 'rmax =',rmax
1815  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1816  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1817  call propagateerrflag_cll
1818  return
1819  end if
1820 
1821  mflag=.true.
1822  if (present(id_in)) then
1823  mflag=.false.
1824  id = id_in
1825  else
1826  id = 0
1827  end if
1828 
1829  if (mflag) then
1830  ! set ID of master call
1831  args(1) = p10
1832  args(2) = p21
1833  args(3) = p32
1834  args(4) = p43
1835  args(5) = p40
1836  args(6) = p20
1837  args(7) = p31
1838  args(8) = p42
1839  args(9) = p30
1840  args(10) = p41
1841  args(11) = m02
1842  args(12) = m12
1843  args(13) = m22
1844  args(14) = m32
1845  args(15) = m42
1846  call setmasterfname_cll('E_cll')
1847  call setmastern_cll(5)
1848  call setmasterr_cll(rmax)
1849  call setmasterargs_cll(15,args)
1850 
1851  call settencache_cll(never_tenred_cll)
1852  end if
1853 
1854 
1855  select case (mode_cll)
1856 
1857  case (1)
1858  ! calculate loop integral using
1859  ! COLI implementation by AD/LH
1860 
1861  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
1862  m02,m12,m22,m32,m42,rmax,id,eerraux,eerr2aux)
1863 
1864  norm = abs(e(0,0,0,0,0))
1865  do r=1,rmax
1866  do n1=0,r
1867  do n2=0,r-n1
1868  do n3=0,r-n1-n2
1869  n4=r-n1-n2-n3
1870  norm = max(norm,abs(e(0,n1,n2,n3,n4)))
1871  end do
1872  end do
1873  end do
1874  end do
1875  if (norm.eq.0d0) then
1876  norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
1877  abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
1878  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
1879  if(norm.ne.0d0) then
1880  norm=1d0/norm**3
1881  else
1882  norm=1d0/muir2_cll**3
1883  end if
1884  end if
1885  if (norm.ne.0d0) then
1886  eacc = eerraux/norm
1887  eacc2 = eerr2aux/norm
1888  else
1889  eacc = 0d0
1890  eacc2 = 0d0
1891  end if
1892 
1893  if (present(eerr)) eerr = eerraux
1894  if (present(eerr2)) eerr2 = eerr2aux
1895 
1896  if (mflag) call propagateaccflag_cll(eacc,rmax)
1897 
1898 
1899  case (2)
1900  ! calculate loop integral using
1901  ! DD implementation by SD
1902 
1903  if (rmax.gt.5) then
1904  call seterrflag_cll(-10)
1905  call errout_cll('E_cll','rank higher than maximum rank implemented in DD library',eflag)
1906  if(eflag) then
1907  write(nerrout_cll,*) 'E_cll: 5-point function of rank>5 not implemented in DD library'
1908  end if
1909  end if
1910 
1911 
1912  ! replace small masses by DD-identifiers
1913  q10 = dreal(getminf2dd_cll(p10))
1914  q21 = dreal(getminf2dd_cll(p21))
1915  q32 = dreal(getminf2dd_cll(p32))
1916  q43 = dreal(getminf2dd_cll(p43))
1917  q40 = dreal(getminf2dd_cll(p40))
1918  q20 = dreal(getminf2dd_cll(p20))
1919  q31 = dreal(getminf2dd_cll(p31))
1920  q42 = dreal(getminf2dd_cll(p42))
1921  q30 = dreal(getminf2dd_cll(p30))
1922  q41 = dreal(getminf2dd_cll(p41))
1923  mm02 = getminf2dd_cll(m02)
1924  mm12 = getminf2dd_cll(m12)
1925  mm22 = getminf2dd_cll(m22)
1926  mm32 = getminf2dd_cll(m32)
1927  mm42 = getminf2dd_cll(m42)
1928 
1929  rank = rmax
1930  call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
1931  mm02,mm12,mm22,mm32,mm42,rank,id)
1932  e(0:rank/2,0:rank,0:rank,0:rank,0:rank) = edd(0:rank/2,0:rank,0:rank,0:rank,0:rank)
1933  euv = 0d0
1934 
1935  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
1936  if (present(eerr)) eerr(0:rmax) = accabsdd(0:rmax)
1937  if (present(eerr2)) eerr2(0:rmax) = accabs2dd(0:rmax)
1938 
1939  norm = abs(e(0,0,0,0,0))
1940  do r=1,rmax
1941  do n1=0,r
1942  do n2=0,r-n1
1943  do n3=0,r-n1-n2
1944  n4=r-n1-n2-n3
1945  norm = max(norm,abs(e(0,n1,n2,n3,n4)))
1946  end do
1947  end do
1948  end do
1949  end do
1950  if (norm.eq.0d0) then
1951  norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
1952  abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
1953  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
1954  if(norm.ne.0d0) then
1955  norm=1d0/norm**3
1956  else
1957  norm=1d0/muir2_cll**3
1958  end if
1959  end if
1960  if (norm.ne.0d0) then
1961  eacc = accabsdd(0:rmax)/norm
1962  eacc2 = accabs2dd(0:rmax)/norm
1963  else
1964  eacc = 0d0
1965  eacc2 = 0d0
1966  end if
1967  if (mflag) call propagateaccflag_cll(eacc,rmax)
1968 
1969 
1970  case (3)
1971  ! cross-check mode
1972  ! compare results for loop integral
1973 
1974 
1975  ! from COLI implementation by AD/LH and
1976  ! from DD implementation by SD
1977 
1978  ! calculate loop integral
1979  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
1980  m02,m12,m22,m32,m42,rmax,id,eerraux,eerr2aux)
1981 
1982 
1983  ! calculate loop integral
1984  if (rmax.gt.5) then
1985  call seterrflag_cll(-10)
1986  call errout_cll('E_cll','rank higher than maximum rank implemented in DD library',eflag)
1987  if(eflag) then
1988  write(nerrout_cll,*) 'E_cll: 5-point function of rank>5 not implemented in DD library'
1989  end if
1990  end if
1991 
1992 
1993  ! replace small masses by DD-identifiers
1994  q10 = dreal(getminf2dd_cll(p10))
1995  q21 = dreal(getminf2dd_cll(p21))
1996  q32 = dreal(getminf2dd_cll(p32))
1997  q43 = dreal(getminf2dd_cll(p43))
1998  q40 = dreal(getminf2dd_cll(p40))
1999  q20 = dreal(getminf2dd_cll(p20))
2000  q31 = dreal(getminf2dd_cll(p31))
2001  q42 = dreal(getminf2dd_cll(p42))
2002  q30 = dreal(getminf2dd_cll(p30))
2003  q41 = dreal(getminf2dd_cll(p41))
2004  mm02 = getminf2dd_cll(m02)
2005  mm12 = getminf2dd_cll(m12)
2006  mm22 = getminf2dd_cll(m22)
2007  mm32 = getminf2dd_cll(m32)
2008  mm42 = getminf2dd_cll(m42)
2009 
2010  rank = rmax
2011  call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
2012  mm02,mm12,mm22,mm32,mm42,rank,id)
2013  e2(0:rank/2,0:rank,0:rank,0:rank,0:rank) = edd(0:rank/2,0:rank,0:rank,0:rank,0:rank)
2014  e2uv = 0d0
2015 
2016  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
2017 
2018  norm_coli = abs(e(0,0,0,0,0))
2019  norm_dd = abs(e2(0,0,0,0,0))
2020  do r=1,rmax
2021  do n1=0,r
2022  do n2=0,r-n1
2023  do n3=0,r-n1-n2
2024  n4=r-n1-n2-n3
2025  norm_coli = max(norm_coli,abs(e(0,n1,n2,n3,n4)))
2026  norm_dd = max(norm_dd,abs(e2(0,n1,n2,n3,n4)))
2027  end do
2028  end do
2029  end do
2030  end do
2031  if (norm_coli.eq.0d0) then
2032  norm_coli = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
2033  abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
2034  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
2035  if(norm_coli.ne.0d0) then
2036  norm_coli=1d0/norm_coli**3
2037  else
2038  norm_coli=1d0/muir2_cll**3
2039  end if
2040  end if
2041  if (norm_dd.eq.0d0) then
2042  norm_dd = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
2043  abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
2044  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
2045  if(norm_dd.ne.0d0) then
2046  norm_dd=1d0/norm_dd**3
2047  else
2048  norm_dd=1d0/muir2_cll**3
2049  end if
2050  end if
2051  norm=min(norm_coli,norm_dd)
2052 
2053  ! cross-check
2054  call checkcoefse_cll(e,e2,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2055  m02,m12,m22,m32,m42,rmax,norm,ediff)
2056 
2057 
2058  if (eerraux(rmax).lt.accabsdd(rmax)) then
2059  if (present(eerr)) eerr = max(eerraux,ediff)
2060  if (present(eerr2)) eerr2 = eerr2aux
2061  if (norm.ne.0d0) then
2062  eacc = max(eerraux/norm_coli,ediff/norm)
2063  eacc2 = eerr2aux/norm_coli
2064  else
2065  eacc = ediff
2066  eacc2 = 0d0
2067  end if
2068  if (monitoring) pointscnte_coli = pointscnte_coli + 1
2069  else
2070  e = e2
2071  euv = e2uv
2072  if (present(eerr)) eerr = max(accabsdd(0:rmax),ediff)
2073  if (present(eerr2)) eerr2 = accabs2dd(0:rmax)
2074  if (norm.ne.0d0) then
2075  eacc = max(accabsdd(0:rmax)/norm_dd,ediff/norm)
2076  eacc2 = accabs2dd(0:rmax)/norm_dd
2077  else
2078  eacc = ediff
2079  eacc2 = 0d0
2080  end if
2081  if (monitoring) pointscnte_dd = pointscnte_dd + 1
2082  end if
2083 
2084  if (mflag) call propagateaccflag_cll(eacc,rmax)
2085 
2086  end select
2087 
2088  if (mflag) call propagateerrflag_cll
2089 
2090  if (monitoring) then
2091  pointscnte_cll = pointscnte_cll + 1
2092 
2093  if(maxval(eacc).gt.reqacc_cll) accpointscnte_cll = accpointscnte_cll + 1
2094 
2095  if(maxval(eacc).gt.critacc_cll) then
2096  critpointscnte_cll = critpointscnte_cll + 1
2097  if ( critpointscnte_cll.le.noutcritpointsmax_cll(5) ) then
2098  call critpointsout_cll('E_cll',0,maxval(eacc), critpointscnte_cll)
2099  if( critpointscnte_cll.eq.noutcritpointsmax_cll(5)) then
2100  write(ncpout_cll,*) ' Further output of Critical Points for E_cll suppressed '
2101  write(ncpout_cll,*)
2102  endif
2103  end if
2104  end if
2105 
2106 #ifdef CritPoints2
2107  if(maxval(eacc2).gt.reqacc_cll) accpointscnte2_cll = accpointscnte2_cll + 1
2108 
2109  if(maxval(eacc2).gt.critacc_cll) then
2110  critpointscnte2_cll = critpointscnte2_cll + 1
2111  if ( critpointscnte2_cll.le.noutcritpointsmax_cll(5) ) then
2112  call critpointsout2_cll('E_cll',0,maxval(eacc2), critpointscnte2_cll)
2113  if( critpointscnte2_cll.eq.noutcritpointsmax_cll(5)) then
2114  write(ncpout2_cll,*) ' Further output of Critical Points for E_cll suppressed '
2115  write(ncpout2_cll,*)
2116  endif
2117  end if
2118  end if
2119 #endif
2120 
2121  end if
2122 
2123 
2124  end subroutine e_main_cll
2125 
2126 
2127 
2128 
2129 
2130  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2131  ! subroutine E_arrays_cll(E,Euv,MomInv,masses2,rmax,Eerr,Eerr2)
2132  !
2133  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2134 
2135 
2136  subroutine e_arrays_cll(E,Euv,MomInv,masses2,rmax,Eerr,Eerr2)
2137 
2138  integer, intent(in) :: rmax
2139  double complex, intent(in) :: MomInv(10), masses2(0:4)
2140  double complex, intent(out) :: E(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2141  double complex, intent(out) :: Euv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2142  double precision, optional, intent(out) :: Eerr(0:rmax),Eerr2(0:rmax)
2143  double precision :: Eerraux(0:rmax),Eerr2aux(0:rmax)
2144 
2145  if (present(eerr)) then
2146  if (present(eerr2)) then
2147  call e_main_cll(e,euv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2148  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2149  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr,eerr2=eerr2)
2150  else
2151  call e_main_cll(e,euv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2152  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2153  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr)
2154  end if
2155  else
2156  if (present(eerr2)) then
2157  call e_main_cll(e,euv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2158  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2159  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerraux,eerr2=eerr2)
2160  else
2161  call e_main_cll(e,euv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2162  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2163  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerraux)
2164  end if
2165  end if
2166 
2167  end subroutine e_arrays_cll
2168 
2169 
2170 
2171 
2172 
2173  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2174  ! subroutine E_list_cll(E,Euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2175  ! m02,m12,m22,m32,m42,rmax,Eerr,Eerr2)
2176  !
2177  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2178 
2179 
2180  subroutine e_list_cll(E,Euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2181  m02,m12,m22,m32,m42,rmax,Eerr,Eerr2)
2182 
2183  integer, intent(in) :: rmax
2184  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
2185  double complex, intent(in) :: m02,m12,m22,m32,m42
2186  double complex, intent(out) :: E(:),Euv(:)
2187  double precision, optional, intent(out) :: Eerr(0:rmax),Eerr2(0:rmax)
2188  logical :: eflag
2189 
2190  if (5.gt.nmax_cll) then
2191  call seterrflag_cll(-10)
2192  call errout_cll('E_cll','Nmax_cll smaller 5',eflag,.true.)
2193  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2194  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 5'
2195  call propagateerrflag_cll
2196  return
2197  end if
2198  if (rmax.gt.rmax_cll) then
2199  call seterrflag_cll(-10)
2200  call errout_cll('E_cll','argument rmax larger than rmax_cll',eflag,.true.)
2201  write(nerrout_cll,*) 'rmax =',rmax
2202  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2203  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2204  call propagateerrflag_cll
2205  return
2206  end if
2207 
2208  call e_list_checked_cll(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2209  m02,m12,m22,m32,m42,rmax,eerr,eerr2)
2210 
2211  end subroutine e_list_cll
2212 
2213 
2214  subroutine e_list_checked_cll(E,Euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2215  m02,m12,m22,m32,m42,rmax,Eerr,Eerr2)
2216 
2217  integer, intent(in) :: rmax
2218  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
2219  double complex, intent(in) :: m02,m12,m22,m32,m42
2220  double complex, intent(out) :: E(NCoefs(rmax,5)),Euv(NCoefs(rmax,5))
2221  double precision, optional, intent(out) :: Eerr(0:rmax),Eerr2(0:rmax)
2222  double complex :: E_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2223  double complex :: Euv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2224  double precision :: Eerraux(0:rmax),Eerr2aux(0:rmax)
2225  integer :: r,n0,n1,n2,n3,n4,cnt
2226 
2227  if (present(eerr)) then
2228  if (present(eerr2)) then
2229  call e_main_cll(e_aux,euv_aux,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2230  m02,m12,m22,m32,m42,rmax,eerr,eerr2=eerr2)
2231  else
2232  call e_main_cll(e_aux,euv_aux,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2233  m02,m12,m22,m32,m42,rmax,eerr)
2234  end if
2235  else
2236  if (present(eerr2)) then
2237  call e_main_cll(e_aux,euv_aux,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2238  m02,m12,m22,m32,m42,rmax,eerraux,eerr2=eerr2)
2239  else
2240  call e_main_cll(e_aux,euv_aux,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2241  m02,m12,m22,m32,m42,rmax,eerraux)
2242  end if
2243  end if
2244 
2245  cnt = 0
2246  do r=0,rmax
2247  do n0=r/2,0,-1
2248  do n1=r-2*n0,0,-1
2249  do n2=r-2*n0-n1,0,-1
2250  do n3=r-2*n0-n1-n2,0,-1
2251  n4=r-2*n0-n1-n2-n3
2252 
2253  cnt=cnt+1
2254  e(cnt) = e_aux(n0,n1,n2,n3,n4)
2255  euv(cnt) = euv_aux(n0,n1,n2,n3,n4)
2256 
2257  end do
2258  end do
2259  end do
2260  end do
2261  end do
2262 
2263  end subroutine e_list_checked_cll
2264 
2265 
2266 
2267 
2268 
2269  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2270  ! subroutine E_arrays_list_cll(E,Euv,MomInv,masses2,rmax,Eerr,Eerr2)
2271  !
2272  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2273 
2274 
2275  subroutine e_arrays_list_cll(E,Euv,MomInv,masses2,rmax,Eerr,Eerr2)
2276 
2277  integer, intent(in) :: rmax
2278  double complex, intent(in) :: MomInv(10), masses2(0:4)
2279  double complex, intent(out) :: E(:),Euv(:)
2280  double precision, optional, intent(out) :: Eerr(0:rmax),Eerr2(0:rmax)
2281  logical :: eflag
2282 
2283  if (5.gt.nmax_cll) then
2284  call seterrflag_cll(-10)
2285  call errout_cll('E_cll','Nmax_cll smaller 5',eflag,.true.)
2286  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2287  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 5'
2288  call propagateerrflag_cll
2289  return
2290  end if
2291  if (rmax.gt.rmax_cll) then
2292  call seterrflag_cll(-10)
2293  call errout_cll('E_cll','argument rmax larger than rmax_cll',eflag,.true.)
2294  write(nerrout_cll,*) 'rmax =',rmax
2295  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2296  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2297  call propagateerrflag_cll
2298  return
2299  end if
2300 
2301  call e_arrays_list_checked_cll(e,euv,mominv,masses2,rmax,eerr,eerr2)
2302 
2303  end subroutine e_arrays_list_cll
2304 
2305 
2306  subroutine e_arrays_list_checked_cll(E,Euv,MomInv,masses2,rmax,Eerr,Eerr2)
2307 
2308  integer, intent(in) :: rmax
2309  double complex, intent(in) :: MomInv(10), masses2(0:4)
2310  double complex, intent(out) :: E(NCoefs(rmax,5)),Euv(NCoefs(rmax,5))
2311  double precision, optional, intent(out) :: Eerr(0:rmax),Eerr2(0:rmax)
2312  double complex :: E_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2313  double complex :: Euv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2314  double precision :: Eerraux(0:rmax),Eerr2aux(0:rmax)
2315  integer :: r,n0,n1,n2,n3,n4,cnt
2316 
2317  if (present(eerr)) then
2318  if (present(eerr2)) then
2319  call e_main_cll(e_aux,euv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2320  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2321  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr,eerr2=eerr2)
2322  else
2323  call e_main_cll(e_aux,euv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2324  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2325  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr)
2326  end if
2327  else
2328  if (present(eerr2)) then
2329  call e_main_cll(e_aux,euv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2330  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2331  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerraux,eerr2=eerr2)
2332  else
2333  call e_main_cll(e_aux,euv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
2334  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
2335  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerraux)
2336  end if
2337  end if
2338 
2339  cnt = 0
2340  do r=0,rmax
2341  do n0=r/2,0,-1
2342  do n1=r-2*n0,0,-1
2343  do n2=r-2*n0-n1,0,-1
2344  do n3=r-2*n0-n1-n2,0,-1
2345  n4=r-2*n0-n1-n2-n3
2346 
2347  cnt=cnt+1
2348  e(cnt) = e_aux(n0,n1,n2,n3,n4)
2349  euv(cnt) = euv_aux(n0,n1,n2,n3,n4)
2350 
2351  end do
2352  end do
2353  end do
2354  end do
2355  end do
2356 
2357  end subroutine e_arrays_list_checked_cll
2358 
2359 
2360 
2361 
2362 
2363  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2364  ! subroutine F_main_cll(F,Fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2365  ! p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,Ferr,id_in,Ferr2)
2366  !
2367  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2368 
2369  subroutine f_main_cll(F,Fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2370  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,Ferr,id_in,Ferr2)
2371 
2372  integer, intent(in) :: rmax
2373  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
2374  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
2375  double complex, intent(out) :: F(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2376  double complex, intent(out) :: Fuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2377  double precision, optional, intent(out) ::Ferr(0:rmax),Ferr2(0:rmax)
2378  double precision :: q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40
2379  double precision :: q51,q30,q41,q52
2380  double complex :: mm02,mm12,mm22,mm32,mm42,mm52
2381  integer, optional, intent(in) :: id_in
2382  double complex :: F2uv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2383  double complex :: F2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2384  double complex :: Fdd(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2385  double precision :: Ferraux(0:rmax),Ferr2aux(0:rmax),Fdiff(0:rmax)
2386  double complex :: elimcminf2
2387  double complex :: args(21)
2388  integer :: n0,rank,errflag,id
2389  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD),Facc(0:rmax),norm,norm_coli,norm_dd,Facc2(0:rmax)
2390  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
2391  integer :: accflagDD,errflagDD,NDD,rankDD
2392  logical :: mflag,eflag
2393  integer :: r,n1,n2,n3,n4,n5
2394 
2395  if (6.gt.nmax_cll) then
2396  call seterrflag_cll(-10)
2397  call errout_cll('F_cll','Nmax_cll smaller 6',eflag,.true.)
2398  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2399  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 6'
2400  call propagateerrflag_cll
2401  return
2402  end if
2403  if (rmax.gt.rmax_cll) then
2404  call seterrflag_cll(-10)
2405  call errout_cll('F_cll','argument rmax larger than rmax_cll',eflag,.true.)
2406  write(nerrout_cll,*) 'rmax =',rmax
2407  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2408  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2409  call propagateerrflag_cll
2410  return
2411  end if
2412 
2413  mflag=.true.
2414  if (present(id_in)) then
2415  mflag=.false.
2416  id = id_in
2417  else
2418  id = 0
2419  end if
2420 
2421  if (mflag) then
2422  ! set ID of master call
2423  args(1) = p10
2424  args(2) = p21
2425  args(3) = p32
2426  args(4) = p43
2427  args(5) = p54
2428  args(6) = p50
2429  args(7) = p20
2430  args(8) = p31
2431  args(9) = p42
2432  args(10) = p53
2433  args(11) = p40
2434  args(12) = p51
2435  args(13) = p30
2436  args(14) = p41
2437  args(15) = p52
2438  args(16) = m02
2439  args(17) = m12
2440  args(18) = m22
2441  args(19) = m32
2442  args(20) = m42
2443  args(21) = m52
2444  call setmasterfname_cll('F_cll')
2445  call setmastern_cll(6)
2446  call setmasterr_cll(rmax)
2447  call setmasterargs_cll(21,args)
2448 
2449  call settencache_cll(never_tenred_cll)
2450  end if
2451 
2452 
2453  select case (mode_cll)
2454 
2455  case (1)
2456  ! calculate loop integral using
2457  ! COLI implementation by AD/LH
2458 
2459  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2460  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,id,ferraux,ferr2aux)
2461 
2462  norm = abs(f(0,0,0,0,0,0))
2463  do r=1,rmax
2464  do n1=0,r
2465  do n2=0,r-n1
2466  do n3=0,r-n1-n2
2467  do n4=0,r-n1-n2-n3
2468  n5=r-n1-n2-n3-n4
2469  norm = max(norm,abs(f(0,n1,n2,n3,n4,n5)))
2470  end do
2471  end do
2472  end do
2473  end do
2474  end do
2475  if (norm.eq.0d0) then
2476  norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p54), &
2477  abs(p50),abs(p20),abs(p31),abs(p42),abs(p53), &
2478  abs(p40),abs(p51),abs(p30),abs(p41),abs(p52), &
2479  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42),abs(m52))
2480  if(norm.ne.0d0) then
2481  norm=1d0/norm**4
2482  else
2483  norm=1d0/muir2_cll**4
2484  end if
2485  end if
2486  if (norm.ne.0d0) then
2487  facc = ferraux/norm
2488  facc2 = ferr2aux/norm
2489  else
2490  facc = 0d0
2491  facc2 = 0d0
2492  end if
2493 
2494  if (present(ferr)) ferr = ferraux
2495  if (present(ferr2)) ferr2 = ferr2aux
2496 
2497  if (mflag) call propagateaccflag_cll(facc,rmax)
2498 
2499 
2500  case (2)
2501  ! calculate loop integral using
2502  ! DD implementation by SD
2503 
2504  id=0
2505  if (rmax.gt.6) then
2506  call seterrflag_cll(-10)
2507  call errout_cll('F_cll','rank higher than maximum rank implemented in DD library',eflag)
2508  if(eflag) then
2509  write(nerrout_cll,*) 'F_cll: 6-point function of rank>6 not implemented in DD library'
2510  end if
2511  end if
2512 
2513 
2514  ! replace small masses by DD-identifiers
2515  q10 = dreal(getminf2dd_cll(p10))
2516  q21 = dreal(getminf2dd_cll(p21))
2517  q32 = dreal(getminf2dd_cll(p32))
2518  q43 = dreal(getminf2dd_cll(p43))
2519  q54 = dreal(getminf2dd_cll(p54))
2520  q50 = dreal(getminf2dd_cll(p50))
2521  q20 = dreal(getminf2dd_cll(p20))
2522  q31 = dreal(getminf2dd_cll(p31))
2523  q42 = dreal(getminf2dd_cll(p42))
2524  q53 = dreal(getminf2dd_cll(p53))
2525  q40 = dreal(getminf2dd_cll(p40))
2526  q51 = dreal(getminf2dd_cll(p51))
2527  q30 = dreal(getminf2dd_cll(p30))
2528  q41 = dreal(getminf2dd_cll(p41))
2529  q52 = dreal(getminf2dd_cll(p52))
2530  mm02 = getminf2dd_cll(m02)
2531  mm12 = getminf2dd_cll(m12)
2532  mm22 = getminf2dd_cll(m22)
2533  mm32 = getminf2dd_cll(m32)
2534  mm42 = getminf2dd_cll(m42)
2535  mm52 = getminf2dd_cll(m52)
2536 
2537  rank = rmax
2538  call f_dd(fdd,q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40, &
2539  q51,q30,q41,q52,mm02,mm12,mm22,mm32,mm42,mm52,rank,id)
2540  f(0:rank/2,0:rank,0:rank,0:rank,0:rank,0:rank) = fdd(0:rank/2,0:rank,0:rank,0:rank,0:rank,0:rank)
2541  fuv = 0d0
2542 
2543  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
2544  if (present(ferr)) ferr(0:rmax) = accabsdd(0:rmax)
2545  if (present(ferr2)) ferr2(0:rmax) = accabs2dd(0:rmax)
2546 
2547  norm = abs(f(0,0,0,0,0,0))
2548  do r=1,rmax
2549  do n1=0,r
2550  do n2=0,r-n1
2551  do n3=0,r-n1-n2
2552  do n4=0,r-n1-n2-n3
2553  n5=r-n1-n2-n3-n4
2554  norm = max(norm,abs(f(0,n1,n2,n3,n4,n5)))
2555  end do
2556  end do
2557  end do
2558  end do
2559  end do
2560  if (norm.eq.0d0) then
2561  norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p54), &
2562  abs(p50),abs(p20),abs(p31),abs(p42),abs(p53), &
2563  abs(p40),abs(p51),abs(p30),abs(p41),abs(p52), &
2564  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42),abs(m52))
2565  if(norm.ne.0d0) then
2566  norm=1d0/norm**4
2567  else
2568  norm=1d0/muir2_cll**4
2569  end if
2570  end if
2571  if (norm.ne.0d0) then
2572  facc = accabsdd(0:rmax)/norm
2573  facc2 = accabs2dd(0:rmax)/norm
2574  else
2575  facc = 0d0
2576  facc2 = 0d0
2577  end if
2578 
2579  if (mflag) call propagateaccflag_cll(facc,rmax)
2580 
2581 
2582  case (3)
2583  ! cross-check mode
2584  ! compare results for loop integral
2585  ! from COLI implementation by AD/LH and
2586  ! from DD implementation by SD
2587 
2588  ! calculate loop integral
2589  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2590  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,id,ferraux,ferr2aux)
2591 
2592 
2593  if (rmax.gt.6) then
2594  call seterrflag_cll(-10)
2595  call errout_cll('F_cll','rank higher than maximum rank implemented in DD library',eflag)
2596  if(eflag) then
2597  write(nerrout_cll,*) 'F_cll: 6-point function of rank>6 not implemented in DD library'
2598  end if
2599  end if
2600 
2601 
2602  ! replace small masses by DD-identifiers
2603  q10 = dreal(getminf2dd_cll(p10))
2604  q21 = dreal(getminf2dd_cll(p21))
2605  q32 = dreal(getminf2dd_cll(p32))
2606  q43 = dreal(getminf2dd_cll(p43))
2607  q54 = dreal(getminf2dd_cll(p54))
2608  q50 = dreal(getminf2dd_cll(p50))
2609  q20 = dreal(getminf2dd_cll(p20))
2610  q31 = dreal(getminf2dd_cll(p31))
2611  q42 = dreal(getminf2dd_cll(p42))
2612  q53 = dreal(getminf2dd_cll(p53))
2613  q40 = dreal(getminf2dd_cll(p40))
2614  q51 = dreal(getminf2dd_cll(p51))
2615  q30 = dreal(getminf2dd_cll(p30))
2616  q41 = dreal(getminf2dd_cll(p41))
2617  q52 = dreal(getminf2dd_cll(p52))
2618  mm02 = getminf2dd_cll(m02)
2619  mm12 = getminf2dd_cll(m12)
2620  mm22 = getminf2dd_cll(m22)
2621  mm32 = getminf2dd_cll(m32)
2622  mm42 = getminf2dd_cll(m42)
2623  mm52 = getminf2dd_cll(m52)
2624 
2625  id=0
2626  rank = rmax
2627  call f_dd(fdd,q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40, &
2628  q51,q30,q41,q52,mm02,mm12,mm22,mm32,mm42,mm52,rank,id)
2629  f2(0:rank/2,0:rank,0:rank,0:rank,0:rank,0:rank) = fdd(0:rank/2,0:rank,0:rank,0:rank,0:rank,0:rank)
2630  f2uv = 0d0
2631 
2632  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
2633 
2634  norm_coli = abs(f(0,0,0,0,0,0))
2635  norm_dd = abs(f2(0,0,0,0,0,0))
2636  do r=1,rmax
2637  do n1=0,r
2638  do n2=0,r-n1
2639  do n3=0,r-n1-n2
2640  do n4=0,r-n1-n2-n3
2641  n5=r-n1-n2-n3-n4
2642  norm_coli = max(norm_coli,abs(f(0,n1,n2,n3,n4,n5)))
2643  norm_dd = max(norm_dd,abs(f2(0,n1,n2,n3,n4,n5)))
2644  end do
2645  end do
2646  end do
2647  end do
2648  end do
2649  if (norm_coli.eq.0d0) then
2650  norm_coli = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p54), &
2651  abs(p50),abs(p20),abs(p31),abs(p42),abs(p53), &
2652  abs(p40),abs(p51),abs(p30),abs(p41),abs(p52), &
2653  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42),abs(m52))
2654  if(norm_coli.ne.0d0) then
2655  norm_coli=1d0/norm_coli**4
2656  else
2657  norm_coli=1d0/muir2_cll**4
2658  end if
2659  end if
2660  if (norm_dd.eq.0d0) then
2661  norm_dd = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p54), &
2662  abs(p50),abs(p20),abs(p31),abs(p42),abs(p53), &
2663  abs(p40),abs(p51),abs(p30),abs(p41),abs(p52), &
2664  abs(m02),abs(m12),abs(m22),abs(m32),abs(m42),abs(m52))
2665  if(norm_dd.ne.0d0) then
2666  norm_dd=1d0/norm_dd**4
2667  else
2668  norm_dd=1d0/muir2_cll**4
2669  end if
2670  end if
2671  norm = min(norm_coli,norm_dd)
2672 
2673  ! cross-check
2674  call checkcoefsf_cll(f,f2,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2675  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,norm,fdiff)
2676 
2677 
2678  if (ferraux(rmax).lt.accabsdd(rmax)) then
2679  if (present(ferr)) ferr = max(ferraux,fdiff)
2680  if (present(ferr2)) ferr2 = ferr2aux
2681  if (norm.ne.0d0) then
2682  facc = max(ferraux/norm_coli,fdiff/norm)
2683  facc2 = ferr2aux/norm_coli
2684  else
2685  facc = fdiff
2686  facc2 = 0d0
2687  end if
2688  if (monitoring) pointscntf_coli = pointscntf_coli + 1
2689  else
2690  f = f2
2691  fuv = f2uv
2692  if (present(ferr)) ferr = max(accabsdd(0:rmax),fdiff)
2693  if (present(ferr2)) ferr2 = accabs2dd(0:rmax)
2694  if (norm.ne.0d0) then
2695  facc = max(accabsdd(0:rmax)/norm_dd,fdiff/norm)
2696  facc2 = accabs2dd(0:rmax)/norm_dd
2697  else
2698  facc = fdiff
2699  facc2 = 0d0
2700  end if
2701  if (monitoring) pointscntf_dd = pointscntf_dd + 1
2702  end if
2703 
2704  if (mflag) call propagateaccflag_cll(facc,rmax)
2705 
2706  end select
2707 
2708  if (mflag) call propagateerrflag_cll
2709 
2710  if (monitoring) then
2711  pointscntf_cll = pointscntf_cll + 1
2712 
2713  if(maxval(facc).gt.reqacc_cll) accpointscntf_cll = accpointscntf_cll + 1
2714 
2715  if(maxval(facc).gt.critacc_cll) then
2716  critpointscntf_cll = critpointscntf_cll + 1
2717  if ( critpointscntf_cll.le.noutcritpointsmax_cll(6) ) then
2718  call critpointsout_cll('F_cll',0,maxval(facc), critpointscntf_cll)
2719  if( critpointscntf_cll.eq.noutcritpointsmax_cll(6)) then
2720  write(ncpout_cll,*) ' Further output of Critical Points for F_cll suppressed '
2721  write(ncpout_cll,*)
2722  endif
2723  end if
2724  end if
2725 
2726 #ifdef CritPoints2
2727  if(maxval(facc2).gt.reqacc_cll) accpointscntf2_cll = accpointscntf2_cll + 1
2728 
2729  if(maxval(facc2).gt.critacc_cll) then
2730  critpointscntf2_cll = critpointscntf2_cll + 1
2731  if ( critpointscntf2_cll.le.noutcritpointsmax_cll(6) ) then
2732  call critpointsout2_cll('F_cll',0,maxval(facc2), critpointscntf2_cll)
2733  if( critpointscntf2_cll.eq.noutcritpointsmax_cll(6)) then
2734  write(ncpout2_cll,*) ' Further output of Critical Points for F_cll suppressed '
2735  write(ncpout2_cll,*)
2736  endif
2737  end if
2738  end if
2739 #endif
2740 
2741  end if
2742 
2743  end subroutine f_main_cll
2744 
2745 
2746 
2747 
2748 
2749  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2750  ! subroutine F_arrays_cll(F,Fuv,MomInv,masses2,rmax,Ferr,Ferr2)
2751  !
2752  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2753 
2754  subroutine f_arrays_cll(F,Fuv,MomInv,masses2,rmax,Ferr,Ferr2)
2755 
2756  integer, intent(in) :: rmax
2757  double complex, intent(in) :: MomInv(15), masses2(0:5)
2758  double complex, intent(out) :: F(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2759  double complex, intent(out) :: Fuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2760  double precision, optional, intent(out) ::Ferr(0:rmax),Ferr2(0:rmax)
2761  double precision :: Ferraux(0:rmax),Ferr2aux(0:rmax)
2762 
2763  if (present(ferr)) then
2764  if (present(ferr2)) then
2765  call f_main_cll(f,fuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2766  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2767  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2768  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr,ferr2=ferr2)
2769  else
2770  call f_main_cll(f,fuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2771  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2772  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2773  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr)
2774  end if
2775  else
2776  if (present(ferr2)) then
2777  call f_main_cll(f,fuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2778  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2779  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2780  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferraux,ferr2=ferr2)
2781  else
2782  call f_main_cll(f,fuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2783  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2784  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2785  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferraux)
2786  end if
2787  end if
2788 
2789  end subroutine f_arrays_cll
2790 
2791 
2792 
2793 
2794 
2795  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2796  ! subroutine F_list_cll(F,Fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2797  ! p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,Ferr,Ferr2)
2798  !
2799  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2800 
2801  subroutine f_list_cll(F,Fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2802  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,Ferr,Ferr2)
2803 
2804  integer, intent(in) :: rmax
2805  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
2806  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
2807  double complex, intent(out) :: F(:),Fuv(:)
2808  double precision, optional, intent(out) ::Ferr(0:rmax),Ferr2(0:rmax)
2809  logical :: eflag
2810 
2811  if (6.gt.nmax_cll) then
2812  call seterrflag_cll(-10)
2813  call errout_cll('F_cll','Nmax_cll smaller 6',eflag,.true.)
2814  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2815  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 6'
2816  call propagateerrflag_cll
2817  return
2818  end if
2819  if (rmax.gt.rmax_cll) then
2820  call seterrflag_cll(-10)
2821  call errout_cll('F_cll','argument rmax larger than rmax_cll',eflag,.true.)
2822  write(nerrout_cll,*) 'rmax =',rmax
2823  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2824  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2825  call propagateerrflag_cll
2826  return
2827  end if
2828 
2829  call f_list_checked_cll(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2830  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,ferr,ferr2)
2831 
2832  end subroutine f_list_cll
2833 
2834 
2835  subroutine f_list_checked_cll(F,Fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2836  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,Ferr,Ferr2)
2837 
2838  integer, intent(in) :: rmax
2839  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
2840  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
2841  double complex, intent(out) :: F(NCoefs(rmax,6)),Fuv(NCoefs(rmax,6))
2842  double precision, optional, intent(out) ::Ferr(0:rmax),Ferr2(0:rmax)
2843  double complex :: F_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2844  double complex :: Fuv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2845  double precision :: Ferraux(0:rmax),Ferr2aux(0:rmax)
2846  integer :: r,n0,n1,n2,n3,n4,n5,cnt
2847 
2848  if (present(ferr)) then
2849  if (present(ferr2)) then
2850  call f_main_cll(f_aux,fuv_aux,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2851  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,ferr,ferr2=ferr2)
2852  else
2853  call f_main_cll(f_aux,fuv_aux,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2854  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,ferr)
2855  end if
2856  else
2857  if (present(ferr2)) then
2858  call f_main_cll(f_aux,fuv_aux,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2859  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,ferraux,ferr2=ferr2)
2860  else
2861  call f_main_cll(f_aux,fuv_aux,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
2862  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,ferraux)
2863  end if
2864  end if
2865 
2866  cnt=0
2867  do r=0,rmax
2868  do n0=r/2,0,-1
2869  do n1=r-2*n0,0,-1
2870  do n2=r-2*n0-n1,0,-1
2871  do n3=r-2*n0-n1-n2,0,-1
2872  do n4=r-2*n0-n1-n2-n3,0,-1
2873  n5=r-2*n0-n1-n2-n3-n4
2874 
2875  cnt = cnt+1
2876  f(cnt) = f_aux(n0,n1,n2,n3,n4,n5)
2877  fuv(cnt) = fuv_aux(n0,n1,n2,n3,n4,n5)
2878 
2879  end do
2880  end do
2881  end do
2882  end do
2883  end do
2884  end do
2885 
2886  end subroutine f_list_checked_cll
2887 
2888 
2889 
2890 
2891  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2892  ! subroutine F_arrays_list_cll(F,Fuv,MomInv,masses2,rmax,Ferr,Ferr2)
2893  !
2894  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2895 
2896  subroutine f_arrays_list_cll(F,Fuv,MomInv,masses2,rmax,Ferr,Ferr2)
2897 
2898  integer, intent(in) :: rmax
2899  double complex, intent(in) :: MomInv(15), masses2(0:5)
2900  double complex, intent(out) :: F(:),Fuv(:)
2901  double precision, optional, intent(out) ::Ferr(0:rmax),Ferr2(0:rmax)
2902  logical :: eflag
2903 
2904  if (6.gt.nmax_cll) then
2905  call seterrflag_cll(-10)
2906  call errout_cll('F_cll','Nmax_cll smaller 6',eflag,.true.)
2907  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2908  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 6'
2909  call propagateerrflag_cll
2910  return
2911  end if
2912  if (rmax.gt.rmax_cll) then
2913  call seterrflag_cll(-10)
2914  call errout_cll('F_cll','argument rmax larger than rmax_cll',eflag,.true.)
2915  write(nerrout_cll,*) 'rmax =',rmax
2916  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2917  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2918  call propagateerrflag_cll
2919  return
2920  end if
2921 
2922  call f_arrays_list_checked_cll(f,fuv,mominv,masses2,rmax,ferr,ferr2)
2923 
2924  end subroutine f_arrays_list_cll
2925 
2926 
2927  subroutine f_arrays_list_checked_cll(F,Fuv,MomInv,masses2,rmax,Ferr,Ferr2)
2928 
2929  integer, intent(in) :: rmax
2930  double complex, intent(in) :: MomInv(15), masses2(0:5)
2931  double complex, intent(out) :: F(NCoefs(rmax,6)),Fuv(NCoefs(rmax,6))
2932  double precision, optional, intent(out) ::Ferr(0:rmax),Ferr2(0:rmax)
2933  double complex :: F_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2934  double complex :: Fuv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
2935  double precision :: Ferraux(0:rmax),Ferr2aux(0:rmax)
2936  integer :: r,n0,n1,n2,n3,n4,n5,cnt
2937 
2938  if (present(ferr)) then
2939  if (present(ferr2)) then
2940  call f_main_cll(f_aux,fuv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2941  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2942  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2943  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr,ferr2=ferr2)
2944  else
2945  call f_main_cll(f_aux,fuv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2946  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2947  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2948  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr)
2949  end if
2950  else
2951  if (present(ferr2)) then
2952  call f_main_cll(f_aux,fuv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2953  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2954  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2955  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferraux,ferr2=ferr2)
2956  else
2957  call f_main_cll(f_aux,fuv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2958  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
2959  mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
2960  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferraux)
2961  end if
2962  end if
2963 
2964  cnt=0
2965  do r=0,rmax
2966  do n0=r/2,0,-1
2967  do n1=r-2*n0,0,-1
2968  do n2=r-2*n0-n1,0,-1
2969  do n3=r-2*n0-n1-n2,0,-1
2970  do n4=r-2*n0-n1-n2-n3,0,-1
2971  n5=r-2*n0-n1-n2-n3-n4
2972 
2973  cnt = cnt+1
2974  f(cnt) = f_aux(n0,n1,n2,n3,n4,n5)
2975  fuv(cnt) = fuv_aux(n0,n1,n2,n3,n4,n5)
2976 
2977  end do
2978  end do
2979  end do
2980  end do
2981  end do
2982  end do
2983 
2984  end subroutine f_arrays_list_checked_cll
2985 
2986 
2987 
2988 
2989 
2990  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2991  ! subroutine G_main_cll(G,Guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
2992  ! p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
2993  ! m02,m12,m22,m32,m42,m52,m62,rmax,Gerr,id_in,Gerr2)
2994  !
2995  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2996 
2997  subroutine g_main_cll(G,Guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
2998  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
2999  m02,m12,m22,m32,m42,m52,m62,rmax,Gerr,id_in,Gerr2)
3000 
3001  integer, intent(in) :: rmax
3002  double complex, intent(in) :: p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53
3003  double complex, intent(in) :: p64,p50,p61,p30,p41,p52,p63,p40,p51,p62
3004  double complex, intent(in) :: m02,m12,m22,m32,m42,m52,m62
3005  double complex, intent(out) :: G(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3006  double complex, intent(out) :: Guv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3007  double precision, optional, intent(out) :: Gerr(0:rmax),Gerr2(0:rmax)
3008  double precision :: Gerraux(0:rmax),Gerr2aux(0:rmax)
3009  double precision :: Gacc(0:rmax), Gacc2(0:rmax),norm,norm_coli,norm_dd
3010  integer, optional, intent(in) :: id_in
3011  double complex :: args(28)
3012  double complex :: elimcminf2
3013  integer :: errflag,id
3014  logical :: mflag,eflag
3015  integer :: r,n1,n2,n3,n4,n5,n6
3016 
3017  if (7.gt.nmax_cll) then
3018  call seterrflag_cll(-10)
3019  call errout_cll('G_cll','Nmax_cll smaller 7',eflag,.true.)
3020  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3021  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 7'
3022  call propagateerrflag_cll
3023  return
3024  end if
3025  if (rmax.gt.rmax_cll) then
3026  call seterrflag_cll(-10)
3027  call errout_cll('G_cll','argument rmax larger than rmax_cll',eflag,.true.)
3028  write(nerrout_cll,*) 'rmax =',rmax
3029  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3030  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3031  call propagateerrflag_cll
3032  return
3033  end if
3034 
3035  mflag=.true.
3036  if (present(id_in)) then
3037  mflag=.false.
3038  id = id_in
3039  else
3040  id = 0
3041  end if
3042 
3043  if (mflag) then
3044  ! set ID of master call
3045  args(1) = p10
3046  args(2) = p21
3047  args(3) = p32
3048  args(4) = p43
3049  args(5) = p54
3050  args(6) = p65
3051  args(7) = p60
3052  args(8) = p20
3053  args(9) = p31
3054  args(10) = p42
3055  args(11) = p53
3056  args(12) = p64
3057  args(13) = p50
3058  args(14) = p61
3059  args(15) = p30
3060  args(16) = p41
3061  args(17) = p52
3062  args(18) = p63
3063  args(19) = p40
3064  args(20) = p51
3065  args(21) = p62
3066  args(22) = m02
3067  args(23) = m12
3068  args(24) = m22
3069  args(25) = m32
3070  args(26) = m42
3071  args(27) = m52
3072  args(28) = m62
3073  call setmasterfname_cll('G_cll')
3074  call setmastern_cll(7)
3075  call setmasterr_cll(rmax)
3076  call setmasterargs_cll(28,args)
3077 
3078  call settencache_cll(never_tenred_cll)
3079  end if
3080 
3081 
3082  select case (mode_cll)
3083 
3084  case (1)
3085  ! calculate loop integral using
3086  ! COLI implementation by AD/LH
3087 
3088  call calcg(g,guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3089  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3090  m02,m12,m22,m32,m42,m52,m62,rmax,id,gerraux,gerr2aux)
3091 
3092  norm = abs(g(0,0,0,0,0,0,0))
3093  do r=1,rmax
3094  do n1=0,r
3095  do n2=0,r-n1
3096  do n3=0,r-n1-n2
3097  do n4=0,r-n1-n2-n3
3098  do n5=0,r-n1-n2-n3-n4
3099  n6=r-n1-n2-n3-n4-n5
3100  norm = max(norm,abs(g(0,n1,n2,n3,n4,n5,n6)))
3101  end do
3102  end do
3103  end do
3104  end do
3105  end do
3106  end do
3107  if (norm.eq.0d0) then
3108  norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p54), &
3109  abs(p65),abs(p60),abs(p20),abs(p31),abs(p42), &
3110  abs(p53),abs(p64),abs(p50),abs(p61),abs(p30), &
3111  abs(p41),abs(p52),abs(p63),abs(p40),abs(p51), &
3112  abs(p62),abs(m02),abs(m12),abs(m22),abs(m32), &
3113  abs(m42),abs(m52),abs(m62))
3114  if(norm.ne.0d0) then
3115  norm=1d0/norm**5
3116  else
3117  norm=1d0/muir2_cll**4
3118  end if
3119  end if
3120  gacc = gerraux/norm
3121  gacc2 = gerr2aux/norm
3122 
3123  if (present(gerr)) gerr = gerraux
3124  if (present(gerr2)) gerr2 = gerr2aux
3125 
3126  if (mflag) call propagateaccflag_cll(gacc,rmax)
3127 
3128 
3129  case (2)
3130  call seterrflag_cll(-10)
3131  call errout_cll('G_cll','7-point functions not implemented in DD library',eflag)
3132  if(eflag) then
3133  write(nerrout_cll,*) 'G_cll: 7-point functions not implemented in DD library'
3134  write(nerrout_cll,*) 'G_cll: --> use COLI implementation (mode_cll=1)'
3135  end if
3136 
3137 
3138  case (3)
3139  ! calculate loop integral using
3140  ! COLI implementation by AD/LH
3141 
3142  call calcg(g,guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3143  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3144  m02,m12,m22,m32,m42,m52,m62,rmax,id,gerraux,gerr2aux)
3145 
3146  norm = abs(g(0,0,0,0,0,0,0))
3147  do r=1,rmax
3148  do n1=0,r
3149  do n2=0,r-n1
3150  do n3=0,r-n1-n2
3151  do n4=0,r-n1-n2-n3
3152  do n5=0,r-n1-n2-n3-n4
3153  n6=r-n1-n2-n3-n4-n5
3154  norm = max(norm,abs(g(0,n1,n2,n3,n4,n5,n6)))
3155  end do
3156  end do
3157  end do
3158  end do
3159  end do
3160  end do
3161  if (norm.eq.0d0) then
3162  norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p54), &
3163  abs(p65),abs(p60),abs(p20),abs(p31),abs(p42), &
3164  abs(p53),abs(p64),abs(p50),abs(p61),abs(p30), &
3165  abs(p41),abs(p52),abs(p63),abs(p40),abs(p51), &
3166  abs(p62),abs(m02),abs(m12),abs(m22),abs(m32), &
3167  abs(m42),abs(m52),abs(m62))
3168  if(norm.ne.0d0) then
3169  norm=1d0/norm**5
3170  else
3171  norm=1d0/muir2_cll**4
3172  end if
3173  end if
3174  gacc = gerraux/norm
3175  gacc2 = gerr2aux/norm
3176 
3177  if (present(gerr)) gerr = gerraux
3178  if (present(gerr2)) gerr2 = gerr2aux
3179 
3180  if (mflag) call propagateaccflag_cll(gacc,rmax)
3181 
3182  call seterrflag_cll(-10)
3183  call errout_cll('G_cll','7-point functions not implemented in DD library',eflag)
3184  if(eflag) then
3185  write(nerrout_cll,*) 'G_cll: 7-point functions not implemented in DD library'
3186  write(nerrout_cll,*) 'G_cll: --> use COLI implementation (mode_cll=1)'
3187  end if
3188 
3189 
3190  end select
3191 
3192  if (mflag) call propagateerrflag_cll
3193 
3194  if (monitoring) then
3195  pointscntg_cll = pointscntg_cll + 1
3196 
3197  if(maxval(gacc).gt.reqacc_cll) accpointscntg_cll = accpointscntg_cll + 1
3198 
3199  if(maxval(gacc).gt.critacc_cll) then
3200  critpointscntg_cll = critpointscntg_cll + 1
3201  if ( critpointscntg_cll.le.noutcritpointsmax_cll(7) ) then
3202  call critpointsout_cll('G_cll',0,maxval(gacc), critpointscntg_cll)
3203  if( critpointscntg_cll.eq.noutcritpointsmax_cll(7)) then
3204  write(ncheckout_cll,*) ' Further output of Critical Points for G_cll suppressed '
3205  write(nerrout_cll,*)
3206  endif
3207  end if
3208  end if
3209 
3210 #ifdef CritPoints2
3211  if (mode_cll.ne.2) then
3212  if(maxval(gacc2).gt.reqacc_cll) accpointscntg2_cll = accpointscntg2_cll + 1
3213 
3214  if(maxval(gacc2).gt.critacc_cll) then
3215  critpointscntg2_cll = critpointscntg2_cll + 1
3216  if ( critpointscntg2_cll.le.noutcritpointsmax_cll(7) ) then
3217  call critpointsout2_cll('G_cll',0,maxval(gacc2), critpointscntg2_cll)
3218  if( critpointscntg2_cll.eq.noutcritpointsmax_cll(7)) then
3219  write(ncpout2_cll,*) ' Further output of Critical Points for G_cll suppressed '
3220  write(ncpout2_cll,*)
3221  endif
3222  end if
3223  end if
3224  end if
3225 #endif
3226 
3227  end if
3228 
3229 
3230  end subroutine g_main_cll
3231 
3232 
3233 
3234 
3235 
3236  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3237  ! subroutine G_arrays_cll(G,Guv,MomInv,masses2,rmax,Gerr,Gerr2)
3238  !
3239  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3240 
3241  subroutine g_arrays_cll(G,Guv,MomInv,masses2,rmax,Gerr,Gerr2)
3242 
3243  integer, intent(in) :: rmax
3244  double complex, intent(in) :: MomInv(21), masses2(0:6)
3245  double complex, intent(out) :: G(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3246  double complex, intent(out) :: Guv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3247  double precision, optional, intent(out) :: Gerr(0:rmax),Gerr2(0:rmax)
3248  double precision :: Gerraux(0:rmax),Gerr2aux(0:rmax)
3249 
3250  if (present(gerr)) then
3251  if (present(gerr2)) then
3252  call g_main_cll(g,guv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3253  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3254  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3255  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3256  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr,gerr2=gerr2)
3257  else
3258  call g_main_cll(g,guv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3259  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3260  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3261  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3262  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr)
3263  end if
3264  else
3265  if (present(gerr2)) then
3266  call g_main_cll(g,guv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3267  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3268  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3269  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3270  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerraux,gerr2=gerr2)
3271  else
3272  call g_main_cll(g,guv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3273  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3274  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3275  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3276  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerraux)
3277  end if
3278  end if
3279 
3280  end subroutine g_arrays_cll
3281 
3282 
3283 
3284 
3285 
3286  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3287  ! subroutine G_list_cll(G,Guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3288  ! p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3289  ! m02,m12,m22,m32,m42,m52,m62,rmax,Gerr,Gerr2)
3290  !
3291  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3292 
3293  subroutine g_list_cll(G,Guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3294  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3295  m02,m12,m22,m32,m42,m52,m62,rmax,Gerr,Gerr2)
3296 
3297  integer, intent(in) :: rmax
3298  double complex, intent(in) :: p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53
3299  double complex, intent(in) :: p64,p50,p61,p30,p41,p52,p63,p40,p51,p62
3300  double complex, intent(in) :: m02,m12,m22,m32,m42,m52,m62
3301  double complex, intent(out) :: G(:),Guv(:)
3302  double precision, optional, intent(out) :: Gerr(0:rmax),Gerr2(0:rmax)
3303  logical :: eflag
3304 
3305  if (7.gt.nmax_cll) then
3306  call seterrflag_cll(-10)
3307  call errout_cll('G_cll','Nmax_cll smaller 7',eflag,.true.)
3308  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3309  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 7'
3310  call propagateerrflag_cll
3311  return
3312  end if
3313  if (rmax.gt.rmax_cll) then
3314  call seterrflag_cll(-10)
3315  call errout_cll('G_cll','argument rmax larger than rmax_cll',eflag,.true.)
3316  write(nerrout_cll,*) 'rmax =',rmax
3317  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3318  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3319  call propagateerrflag_cll
3320  return
3321  end if
3322 
3323  call g_list_checked_cll(g,guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3324  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3325  m02,m12,m22,m32,m42,m52,m62,rmax,gerr,gerr2)
3326 
3327  end subroutine g_list_cll
3328 
3329 
3330  subroutine g_list_checked_cll(G,Guv,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3331  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3332  m02,m12,m22,m32,m42,m52,m62,rmax,Gerr,Gerr2)
3333 
3334  integer, intent(in) :: rmax
3335  double complex, intent(in) :: p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53
3336  double complex, intent(in) :: p64,p50,p61,p30,p41,p52,p63,p40,p51,p62
3337  double complex, intent(in) :: m02,m12,m22,m32,m42,m52,m62
3338  double complex, intent(out) :: G(NCoefs(rmax,7))
3339  double complex, intent(out) :: Guv(NCoefs(rmax,7))
3340  double precision, optional, intent(out) :: Gerr(0:rmax),Gerr2(0:rmax)
3341  double complex :: G_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3342  double complex :: Guv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3343  double precision :: Gerraux(0:rmax),Gerr2aux(0:rmax)
3344  integer :: r,n0,n1,n2,n3,n4,n5,n6,cnt
3345 
3346  if (present(gerr)) then
3347  if (present(gerr2)) then
3348  call g_main_cll(g_aux,guv_aux,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3349  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3350  m02,m12,m22,m32,m42,m52,m62,rmax,gerr,gerr2=gerr2)
3351  else
3352  call g_main_cll(g_aux,guv_aux,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3353  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3354  m02,m12,m22,m32,m42,m52,m62,rmax,gerr)
3355  end if
3356  else
3357  if (present(gerr2)) then
3358  call g_main_cll(g_aux,guv_aux,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3359  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3360  m02,m12,m22,m32,m42,m52,m62,rmax,gerraux,gerr2=gerr2)
3361  else
3362  call g_main_cll(g_aux,guv_aux,p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
3363  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
3364  m02,m12,m22,m32,m42,m52,m62,rmax,gerraux)
3365  end if
3366  end if
3367 
3368  cnt = 0
3369  do r=0,rmax
3370  do n0=r/2,0,-1
3371  do n1=r-2*n0,0,-1
3372  do n2=r-2*n0-n1,0,-1
3373  do n3=r-2*n0-n1-n2,0,-1
3374  do n4=r-2*n0-n1-n2-n3,0,-1
3375  do n5=r-2*n0-n1-n2-n3-n4,0,-1
3376  n6 = r-2*n0-n1-n2-n3-n4-n5
3377 
3378  cnt = cnt+1
3379  g(cnt) = g_aux(n0,n1,n2,n3,n4,n5,n6)
3380  guv(cnt) = guv_aux(n0,n1,n2,n3,n4,n5,n6)
3381 
3382  end do
3383  end do
3384  end do
3385  end do
3386  end do
3387  end do
3388  end do
3389 
3390  end subroutine g_list_checked_cll
3391 
3392 
3393 
3394 
3395 
3396  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3397  ! subroutine G_arrays_list_cll(G,Guv,MomInv,masses2,rmax,Gerr,Gerr2)
3398  !
3399  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3400 
3401  subroutine g_arrays_list_cll(G,Guv,MomInv,masses2,rmax,Gerr,Gerr2)
3402 
3403  integer, intent(in) :: rmax
3404  double complex, intent(in) :: MomInv(21), masses2(0:6)
3405  double complex, intent(out) :: G(:),Guv(:)
3406  double precision, optional, intent(out) :: Gerr(0:rmax),Gerr2(0:rmax)
3407  logical :: eflag
3408 
3409  if (7.gt.nmax_cll) then
3410  call seterrflag_cll(-10)
3411  call errout_cll('G_cll','Nmax_cll smaller 7',eflag,.true.)
3412  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3413  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 7'
3414  call propagateerrflag_cll
3415  return
3416  end if
3417  if (rmax.gt.rmax_cll) then
3418  call seterrflag_cll(-10)
3419  call errout_cll('G_cll','argument rmax larger than rmax_cll',eflag,.true.)
3420  write(nerrout_cll,*) 'rmax =',rmax
3421  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3422  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3423  call propagateerrflag_cll
3424  return
3425  end if
3426 
3427  call g_arrays_list_checked_cll(g,guv,mominv,masses2,rmax,gerr,gerr2)
3428 
3429  end subroutine g_arrays_list_cll
3430 
3431 
3432  subroutine g_arrays_list_checked_cll(G,Guv,MomInv,masses2,rmax,Gerr,Gerr2)
3433 
3434  integer, intent(in) :: rmax
3435  double complex, intent(in) :: MomInv(21), masses2(0:6)
3436  double complex, intent(out) :: G(NCoefs(rmax,7))
3437  double complex, intent(out) :: Guv(NCoefs(rmax,7))
3438  double precision, optional, intent(out) :: Gerr(0:rmax),Gerr2(0:rmax)
3439  double complex :: G_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3440  double complex :: Guv_aux(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3441  double precision :: Gerraux(0:rmax),Gerr2aux(0:rmax)
3442  integer :: r,n0,n1,n2,n3,n4,n5,n6,cnt
3443 
3444  if (present(gerr)) then
3445  if (present(gerr2)) then
3446  call g_main_cll(g_aux,guv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3447  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3448  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3449  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3450  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr,gerr2=gerr2)
3451  else
3452  call g_main_cll(g_aux,guv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3453  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3454  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3455  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3456  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr)
3457  end if
3458  else
3459  if (present(gerr)) then
3460  call g_main_cll(g_aux,guv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3461  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3462  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3463  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3464  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerraux,gerr2=gerr2)
3465  else
3466  call g_main_cll(g_aux,guv_aux,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
3467  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
3468  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
3469  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1), &
3470  masses2(2),masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerraux)
3471  end if
3472  end if
3473 
3474  cnt = 0
3475  do r=0,rmax
3476  do n0=r/2,0,-1
3477  do n1=r-2*n0,0,-1
3478  do n2=r-2*n0-n1,0,-1
3479  do n3=r-2*n0-n1-n2,0,-1
3480  do n4=r-2*n0-n1-n2-n3,0,-1
3481  do n5=r-2*n0-n1-n2-n3-n4,0,-1
3482  n6 = r-2*n0-n1-n2-n3-n4-n5
3483 
3484  cnt = cnt+1
3485  g(cnt) = g_aux(n0,n1,n2,n3,n4,n5,n6)
3486  guv(cnt) = guv_aux(n0,n1,n2,n3,n4,n5,n6)
3487 
3488  end do
3489  end do
3490  end do
3491  end do
3492  end do
3493  end do
3494  end do
3495 
3496  end subroutine g_arrays_list_checked_cll
3497 
3498 
3499 
3500 
3501 
3502  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3503  ! subroutine TN_main_cll(TN,TNuv,MomInv,masses2,N,rmax,TNerr,id_in,TNerr2)
3504  !
3505  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3506 
3507  subroutine tn_main_cll(TN,TNuv,MomInv,masses2,N,rmax,TNerr,id_in,TNerr2)
3508 
3509  integer, intent(in) :: N,rmax
3510  double complex, intent(in) :: MomInv(:), masses2(0:)
3511  double complex, intent(out) :: TN(:)
3512  double complex, intent(out) :: TNuv(:)
3513  integer, optional, intent(in) :: id_in
3514  double precision, optional, intent(out) :: TNerr(0:),TNerr2(0:)
3515  logical :: eflag
3516 
3517  if (n.eq.1) then
3518  call seterrflag_cll(-10)
3519  call errout_cll('TN_cll','subroutine called with wrong number of arguments for N=1',eflag,.true.)
3520  call propagateerrflag_cll
3521  return
3522  end if
3523  if (n.gt.nmax_cll) then
3524  call seterrflag_cll(-10)
3525  call errout_cll('TN_cll','argument N larger than Nmax_cll',eflag,.true.)
3526  write(nerrout_cll,*) 'N =',n
3527  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3528  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= ',n
3529  call propagateerrflag_cll
3530  return
3531  end if
3532  if (rmax.gt.rmax_cll) then
3533  call seterrflag_cll(-10)
3534  call errout_cll('TN_cll','argument rmax larger than rmax_cll',eflag,.true.)
3535  write(nerrout_cll,*) 'rmax =',rmax
3536  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3537  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3538  call propagateerrflag_cll
3539  return
3540  end if
3541 
3542  call tn_main_checked_cll(tn,tnuv,mominv,masses2,n,rmax,tnerr,id_in,tnerr2)
3543 
3544  end subroutine tn_main_cll
3545 
3546 
3547  subroutine tn_main_checked_cll(TN,TNuv,MomInv,masses2,N,rmax,TNerr,id_in,TNerr2)
3548 
3549  integer, intent(in) :: N,rmax
3550  double complex, intent(in) :: MomInv(BinomTable(2,N)), masses2(0:N-1)
3551  double complex, intent(out) :: TN(NCoefs(rmax,N))
3552  double complex, intent(out) :: TNuv(NCoefs(rmax,N))
3553  integer, optional, intent(in) :: id_in
3554  double precision, optional, intent(out) :: TNerr(0:rmax),TNerr2(0:rmax)
3555  double precision :: q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40
3556  double precision :: q51,q30,q41,q52
3557  double complex :: mm02,mm12,mm22,mm32,mm42,mm52
3558  double complex :: TN2(NCoefs(rmax,N)),TN2uv(NCoefs(rmax,N))
3559  double complex :: Adduv(0:rmax/2), Bdduv(0:rmax,0:rmax)
3560  double complex :: Cdduv(0:rmax,0:rmax,0:rmax)
3561  double complex :: Ddduv(0:rmax,0:rmax,0:rmax,0:rmax)
3562  double complex :: Add(0:rmax/2), Bdd(0:rmax,0:rmax)
3563  double complex :: Cdd(0:rmax,0:rmax,0:rmax)
3564  double complex :: Ddd(0:rmax,0:rmax,0:rmax,0:rmax)
3565  double complex :: Edd(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3566  double complex :: Fdd(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3567  double complex :: elimcminf2
3568  double precision :: TNerraux(0:rmax),TNerr2aux(0:rmax),TNdiff(0:rmax)
3569  double complex :: args(BinomTable(2,N)+N)
3570  integer :: n0,n1,n2,n3,n4,n5,r,i,cnt,rank,errflag
3571  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD)
3572  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
3573  double precision :: TNacc(0:rmax),TNacc2(0:rmax),norm,norm_coli,norm_dd
3574  integer :: accflagDD,errflagDD,rankDD,NDD,id
3575  logical :: mflag,eflag
3576 
3577 ! if (N.eq.1) then
3578 ! call SetErrFlag_cll(-10)
3579 ! call ErrOut_cll('TN_cll','subroutine called with wrong number of arguments for N=1',eflag)
3580 ! return
3581 ! end if
3582 
3583  mflag=.true.
3584  if (present(id_in)) then
3585  mflag=.false.
3586  id = id_in
3587  else
3588  id = 0
3589  end if
3590 
3591  if (mflag) then
3592  args(1:binomtable(2,n)) = mominv
3593  args(binomtable(2,n)+1:binomtable(2,n)+n) = masses2(0:n-1)
3594  call setmasterfname_cll('TN_cll')
3595  call setmastern_cll(n)
3596  call setmasterr_cll(rmax)
3597  call setmasterargs_cll(binomtable(2,n)+n,args)
3598 
3599  call settencache_cll(never_tenred_cll)
3600  end if
3601 
3602 
3603  select case (mode_cll)
3604 
3605  case (1)
3606  ! calculate loop integral using
3607  ! COLI implementation by AD/LH
3608 
3609  call calctn(tn,tnuv,mominv,masses2,n,rmax,id,tnerraux,tnerr2aux)
3610 
3611  if (present(tnerr)) tnerr = tnerraux
3612  if (present(tnerr2)) tnerr2 = tnerr2aux
3613 
3614  norm = abs(tn(1))
3615  do r=1,rmax
3616  do i=ncoefs(r,n)-binomtable(r,r+n-2)+1,ncoefs(r,n)
3617  norm = max(norm,abs(tn(i)))
3618  end do
3619  end do
3620  if (norm.eq.0d0) then
3621  norm = max(maxval(abs(mominv(1:binomtable(2,n)))), &
3622  maxval(abs(masses2(0:n-1))))
3623  if(norm.ne.0d0) then
3624  norm=1d0/norm**(n-2)
3625  else
3626  norm=1d0/muir2_cll**(n-2)
3627  end if
3628  end if
3629  if (norm.ne.0d0) then
3630  tnacc = tnerraux/norm
3631  tnacc2 = tnerr2aux/norm
3632  else
3633  tnacc = 0d0
3634  tnacc2 = 0d0
3635  end if
3636 
3637  if (mflag) call propagateaccflag_cll(tnacc,rmax)
3638 
3639 
3640  case (2)
3641  ! calculate loop integral using
3642  ! DD implementation by SD
3643 
3644  select case (n)
3645 
3646  case(2)
3647 
3648  id=0
3649 
3650  ! replace small masses by DD-identifiers
3651  q10 = dreal(getminf2dd_cll(mominv(1)))
3652  mm02 = getminf2dd_cll(masses2(0))
3653  mm12 = getminf2dd_cll(masses2(1))
3654 
3655  rank = rmax
3656  call b_dd(bdd,bdduv,q10,mm02,mm12,rank,id)
3657 
3658  cnt = 0
3659  do r=0,rank
3660  do n0=r/2,0,-1
3661  n1=r-2*n0
3662 
3663  cnt = cnt+1
3664  tn(cnt) = bdd(n0,n1)
3665  tnuv(cnt) = bdduv(n0,n1)
3666 
3667  end do
3668  end do
3669 
3670 
3671  case(3)
3672 
3673  id=0
3674 
3675  ! replace small masses by DD-identifiers
3676  q10 = dreal(getminf2dd_cll(mominv(1)))
3677  q21 = dreal(getminf2dd_cll(mominv(2)))
3678  q20 = dreal(getminf2dd_cll(mominv(3)))
3679  mm02 = getminf2dd_cll(masses2(0))
3680  mm12 = getminf2dd_cll(masses2(1))
3681  mm22 = getminf2dd_cll(masses2(2))
3682 
3683  rank = rmax
3684  call c_dd(cdd,cdduv,q10,q21,q20,mm02,mm12,mm22,rank,id)
3685 
3686  cnt = 0
3687  do r=0,rank
3688  do n0=r/2,0,-1
3689  do n1=r-2*n0,0,-1
3690  n2 = r-2*n0-n1
3691 
3692  cnt = cnt+1
3693  tn(cnt) = cdd(n0,n1,n2)
3694  tnuv(cnt) = cdduv(n0,n1,n2)
3695 
3696  end do
3697  end do
3698  end do
3699 
3700 
3701  case(4)
3702 
3703  id=0
3704 
3705  ! replace small masses by DD-identifiers
3706  q10 = dreal(getminf2dd_cll(mominv(1)))
3707  q21 = dreal(getminf2dd_cll(mominv(2)))
3708  q32 = dreal(getminf2dd_cll(mominv(3)))
3709  q30 = dreal(getminf2dd_cll(mominv(4)))
3710  q20 = dreal(getminf2dd_cll(mominv(5)))
3711  q31 = dreal(getminf2dd_cll(mominv(6)))
3712  mm02 = getminf2dd_cll(masses2(0))
3713  mm12 = getminf2dd_cll(masses2(1))
3714  mm22 = getminf2dd_cll(masses2(2))
3715  mm32 = getminf2dd_cll(masses2(3))
3716 
3717  rank = rmax
3718  call d_dd(ddd,ddduv,q10,q21,q32,q30,q20,q31, &
3719  mm02,mm12,mm22,mm32,rank,id)
3720 
3721  cnt = 0
3722  do r=0,rank
3723  do n0=r/2,0,-1
3724  do n1=r-2*n0,0,-1
3725  do n2=r-2*n0-n1,0,-1
3726  n3 = r-2*n0-n1-n2
3727 
3728  cnt = cnt+1
3729  tn(cnt) = ddd(n0,n1,n2,n3)
3730  tnuv(cnt) = ddduv(n0,n1,n2,n3)
3731 
3732  end do
3733  end do
3734  end do
3735  end do
3736 
3737 
3738  case(5)
3739 
3740  if (rmax.gt.5) then
3741  call seterrflag_cll(-10)
3742  call errout_cll('TN_cll','rank higher than maximum rank implemented in DD library',eflag)
3743  if(eflag) then
3744  write(nerrout_cll,*) 'TN_cll: 5-point function of rank>5 not implemented in DD library'
3745  end if
3746  end if
3747 
3748  ! replace small masses by DD-identifiers
3749  q10 = dreal(getminf2dd_cll(mominv(1)))
3750  q21 = dreal(getminf2dd_cll(mominv(2)))
3751  q32 = dreal(getminf2dd_cll(mominv(3)))
3752  q43 = dreal(getminf2dd_cll(mominv(4)))
3753  q40 = dreal(getminf2dd_cll(mominv(5)))
3754  q20 = dreal(getminf2dd_cll(mominv(6)))
3755  q31 = dreal(getminf2dd_cll(mominv(7)))
3756  q42 = dreal(getminf2dd_cll(mominv(8)))
3757  q30 = dreal(getminf2dd_cll(mominv(9)))
3758  q41 = dreal(getminf2dd_cll(mominv(10)))
3759  mm02 = getminf2dd_cll(masses2(0))
3760  mm12 = getminf2dd_cll(masses2(1))
3761  mm22 = getminf2dd_cll(masses2(2))
3762  mm32 = getminf2dd_cll(masses2(3))
3763  mm42 = getminf2dd_cll(masses2(4))
3764 
3765  rank = rmax
3766  call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
3767  mm02,mm12,mm22,mm32,mm42,rank,id)
3768 
3769  tnuv = 0d0
3770  cnt = 0
3771  do r=0,rank
3772  do n0=r/2,0,-1
3773  do n1=r-2*n0,0,-1
3774  do n2=r-2*n0-n1,0,-1
3775  do n3=r-2*n0-n1-n2,0,-1
3776  n4 = r-2*n0-n1-n2-n3
3777 
3778  cnt = cnt+1
3779  tn(cnt) = edd(n0,n1,n2,n3,n4)
3780 
3781  end do
3782  end do
3783  end do
3784  end do
3785  end do
3786 
3787 
3788  case(6)
3789 
3790  if (rmax.gt.6) then
3791  call seterrflag_cll(-10)
3792  call errout_cll('TN_cll','rank higher than maximum rank implemented in DD library',eflag)
3793  if(eflag) then
3794  write(nerrout_cll,*) 'TN_cll: 6-point function of rank>6 not implemented in DD library'
3795  end if
3796  end if
3797 
3798  ! replace small masses by DD-identifiers
3799  q10 = dreal(getminf2dd_cll(mominv(1)))
3800  q21 = dreal(getminf2dd_cll(mominv(2)))
3801  q32 = dreal(getminf2dd_cll(mominv(3)))
3802  q43 = dreal(getminf2dd_cll(mominv(4)))
3803  q54 = dreal(getminf2dd_cll(mominv(5)))
3804  q50 = dreal(getminf2dd_cll(mominv(6)))
3805  q20 = dreal(getminf2dd_cll(mominv(7)))
3806  q31 = dreal(getminf2dd_cll(mominv(8)))
3807  q42 = dreal(getminf2dd_cll(mominv(9)))
3808  q53 = dreal(getminf2dd_cll(mominv(10)))
3809  q40 = dreal(getminf2dd_cll(mominv(11)))
3810  q51 = dreal(getminf2dd_cll(mominv(12)))
3811  q30 = dreal(getminf2dd_cll(mominv(13)))
3812  q41 = dreal(getminf2dd_cll(mominv(14)))
3813  q52 = dreal(getminf2dd_cll(mominv(15)))
3814  mm02 = getminf2dd_cll(masses2(0))
3815  mm12 = getminf2dd_cll(masses2(1))
3816  mm22 = getminf2dd_cll(masses2(2))
3817  mm32 = getminf2dd_cll(masses2(3))
3818  mm42 = getminf2dd_cll(masses2(4))
3819  mm52 = getminf2dd_cll(masses2(5))
3820 
3821  rank = rmax
3822  call f_dd(fdd,q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40, &
3823  q51,q30,q41,q52,mm02,mm12,mm22,mm32,mm42,mm52,rank,id)
3824 
3825  tnuv = 0d0
3826  cnt = 0
3827  do r=0,rank
3828  do n0=r/2,0,-1
3829  do n1=r-2*n0,0,-1
3830  do n2=r-2*n0-n1,0,-1
3831  do n3=r-2*n0-n1-n2,0,-1
3832  do n4=r-2*n0-n1-n2-n3,0,-1
3833  n5 = r-2*n0-n1-n2-n3-n4
3834 
3835  cnt = cnt+1
3836  tn(cnt) = fdd(n0,n1,n2,n3,n4,n5)
3837 
3838  end do
3839  end do
3840  end do
3841  end do
3842  end do
3843  end do
3844 
3845 
3846  case(7:)
3847 
3848  call seterrflag_cll(-10)
3849  call errout_cll('TN_cll','N-point functions not implemented in DD library for N>=7',eflag)
3850  if(eflag) then
3851  write(nerrout_cll,*) 'TN_cll: N-point functions not implemented in DD library for N>=7'
3852  write(nerrout_cll,*) 'TN_cll: --> use COLI implementation (mode_cll=1)'
3853  end if
3854 
3855 
3856  end select
3857 
3858  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
3859 
3860  if (present(tnerr)) tnerr(0:rmax) = accabsdd(0:rmax)
3861  if (present(tnerr2)) tnerr2(0:rmax) = accabs2dd(0:rmax)
3862 
3863  norm = abs(tn(1))
3864  do r=1,rmax
3865  do i=ncoefs(r,n)-binomtable(r,r+n-2)+1,ncoefs(r,n)
3866  norm = max(norm,abs(tn(i)))
3867  end do
3868  end do
3869  if (norm.eq.0d0) then
3870  norm = max(maxval(abs(mominv(1:binomtable(2,n)))), &
3871  maxval(abs(masses2(0:n-1))))
3872  if(norm.ne.0d0) then
3873  norm=1d0/norm**(n-2)
3874  else
3875  norm=1d0/muir2_cll**(n-2)
3876  end if
3877  end if
3878  if (norm.ne.0d0) then
3879  tnacc = accabsdd(0:rmax)/norm
3880  tnacc2 = accabs2dd(0:rmax)/norm
3881  else
3882  tnacc = 0d0
3883  tnacc2 = 0d0
3884  end if
3885  if (mflag) call propagateaccflag_cll(tnacc,rmax)
3886 
3887 
3888  case (3)
3889  ! cross-check mode
3890  ! compare results for loop integral
3891  ! from COLI implementation by AD/LH and
3892  ! from DD implementation by SD
3893 
3894  ! calculate loop-integral using COLI
3895  call calctn(tn,tnuv,mominv,masses2,n,rmax,id,tnerraux,tnerr2aux)
3896 
3897 
3898  select case (n)
3899 
3900  case(2)
3901 
3902  id=0
3903 
3904  ! replace small masses by DD-identifiers
3905  q10 = dreal(getminf2dd_cll(mominv(1)))
3906  mm02 = getminf2dd_cll(masses2(0))
3907  mm12 = getminf2dd_cll(masses2(1))
3908 
3909  ! calculate loop-integral using DD
3910  rank = rmax
3911  call b_dd(bdd,bdduv,q10,mm02,mm12,rank,id)
3912  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
3913 
3914  cnt = 0
3915  do r=0,rank
3916  do n0=r/2,0,-1
3917  n1=r-2*n0
3918 
3919  cnt = cnt+1
3920  tn2(cnt) = bdd(n0,n1)
3921  tn2uv(cnt) = bdduv(n0,n1)
3922 
3923  end do
3924  end do
3925 
3926 
3927  case(3)
3928 
3929  id=0
3930 
3931  ! replace small masses by DD-identifiers
3932  q10 = dreal(getminf2dd_cll(mominv(1)))
3933  q21 = dreal(getminf2dd_cll(mominv(2)))
3934  q20 = dreal(getminf2dd_cll(mominv(3)))
3935  mm02 = getminf2dd_cll(masses2(0))
3936  mm12 = getminf2dd_cll(masses2(1))
3937  mm22 = getminf2dd_cll(masses2(2))
3938 
3939  ! calculate loop-integral using DD
3940  rank = rmax
3941  call c_dd(cdd,cdduv,q10,q21,q20,mm02,mm12,mm22,rank,id)
3942  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
3943 
3944  cnt = 0
3945  do r=0,rank
3946  do n0=r/2,0,-1
3947  do n1=r-2*n0,0,-1
3948  n2 = r-2*n0-n1
3949 
3950  cnt = cnt+1
3951  tn2(cnt) = cdd(n0,n1,n2)
3952  tn2uv(cnt) = cdduv(n0,n1,n2)
3953 
3954  end do
3955  end do
3956  end do
3957 
3958 
3959  case(4)
3960 
3961  id=0
3962 
3963  ! replace small masses by DD-identifiers
3964  q10 = dreal(getminf2dd_cll(mominv(1)))
3965  q21 = dreal(getminf2dd_cll(mominv(2)))
3966  q32 = dreal(getminf2dd_cll(mominv(3)))
3967  q30 = dreal(getminf2dd_cll(mominv(4)))
3968  q20 = dreal(getminf2dd_cll(mominv(5)))
3969  q31 = dreal(getminf2dd_cll(mominv(6)))
3970  mm02 = getminf2dd_cll(masses2(0))
3971  mm12 = getminf2dd_cll(masses2(1))
3972  mm22 = getminf2dd_cll(masses2(2))
3973  mm32 = getminf2dd_cll(masses2(3))
3974 
3975  ! calculate loop-integral using DD
3976  rank = rmax
3977  call d_dd(ddd,ddduv,q10,q21,q32,q30,q20,q31, &
3978  mm02,mm12,mm22,mm32,rank,id)
3979  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
3980 
3981  cnt = 0
3982  do r=0,rank
3983  do n0=r/2,0,-1
3984  do n1=r-2*n0,0,-1
3985  do n2=r-2*n0-n1,0,-1
3986  n3 = r-2*n0-n1-n2
3987 
3988  cnt = cnt+1
3989  tn2(cnt) = ddd(n0,n1,n2,n3)
3990  tn2uv(cnt) = ddduv(n0,n1,n2,n3)
3991 
3992  end do
3993  end do
3994  end do
3995  end do
3996 
3997 
3998  case(5)
3999 
4000  if (rmax.gt.5) then
4001  call seterrflag_cll(-10)
4002  call errout_cll('TN_cll','rank higher than maximum rank implemented in DD library',eflag)
4003  if(eflag) then
4004  write(nerrout_cll,*) 'TN_cll: 5-point function of rank>5 not implemented in DD library'
4005  end if
4006  end if
4007 
4008  ! replace small masses by DD-identifiers
4009  q10 = dreal(getminf2dd_cll(mominv(1)))
4010  q21 = dreal(getminf2dd_cll(mominv(2)))
4011  q32 = dreal(getminf2dd_cll(mominv(3)))
4012  q43 = dreal(getminf2dd_cll(mominv(4)))
4013  q40 = dreal(getminf2dd_cll(mominv(5)))
4014  q20 = dreal(getminf2dd_cll(mominv(6)))
4015  q31 = dreal(getminf2dd_cll(mominv(7)))
4016  q42 = dreal(getminf2dd_cll(mominv(8)))
4017  q30 = dreal(getminf2dd_cll(mominv(9)))
4018  q41 = dreal(getminf2dd_cll(mominv(10)))
4019  mm02 = getminf2dd_cll(masses2(0))
4020  mm12 = getminf2dd_cll(masses2(1))
4021  mm22 = getminf2dd_cll(masses2(2))
4022  mm32 = getminf2dd_cll(masses2(3))
4023  mm42 = getminf2dd_cll(masses2(4))
4024 
4025  ! calculate loop-integral using DD
4026  rank = rmax
4027  call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
4028  mm02,mm12,mm22,mm32,mm42,rank,id)
4029  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
4030 
4031  tn2uv = 0d0
4032  cnt = 0
4033  do r=0,rank
4034  do n0=r/2,0,-1
4035  do n1=r-2*n0,0,-1
4036  do n2=r-2*n0-n1,0,-1
4037  do n3=r-2*n0-n1-n2,0,-1
4038  n4 = r-2*n0-n1-n2-n3
4039 
4040  cnt = cnt+1
4041  tn2(cnt) = edd(n0,n1,n2,n3,n4)
4042 
4043  end do
4044  end do
4045  end do
4046  end do
4047  end do
4048 
4049 
4050  case(6)
4051 
4052  if (rmax.gt.6) then
4053  call seterrflag_cll(-10)
4054  call errout_cll('TN_cll','rank higher than maximum rank implemented in DD library',eflag)
4055  if(eflag) then
4056  write(nerrout_cll,*) 'TN_cll: 6-point function of rank>6 not implemented in DD library'
4057  end if
4058  end if
4059 
4060  ! replace small masses by DD-identifiers
4061  q10 = dreal(getminf2dd_cll(mominv(1)))
4062  q21 = dreal(getminf2dd_cll(mominv(2)))
4063  q32 = dreal(getminf2dd_cll(mominv(3)))
4064  q43 = dreal(getminf2dd_cll(mominv(4)))
4065  q54 = dreal(getminf2dd_cll(mominv(5)))
4066  q50 = dreal(getminf2dd_cll(mominv(6)))
4067  q20 = dreal(getminf2dd_cll(mominv(7)))
4068  q31 = dreal(getminf2dd_cll(mominv(8)))
4069  q42 = dreal(getminf2dd_cll(mominv(9)))
4070  q53 = dreal(getminf2dd_cll(mominv(10)))
4071  q40 = dreal(getminf2dd_cll(mominv(11)))
4072  q51 = dreal(getminf2dd_cll(mominv(12)))
4073  q30 = dreal(getminf2dd_cll(mominv(13)))
4074  q41 = dreal(getminf2dd_cll(mominv(14)))
4075  q52 = dreal(getminf2dd_cll(mominv(15)))
4076  mm02 = getminf2dd_cll(masses2(0))
4077  mm12 = getminf2dd_cll(masses2(1))
4078  mm22 = getminf2dd_cll(masses2(2))
4079  mm32 = getminf2dd_cll(masses2(3))
4080  mm42 = getminf2dd_cll(masses2(4))
4081  mm52 = getminf2dd_cll(masses2(5))
4082 
4083  ! calculate loop-integral using DD
4084  rank = rmax
4085  call f_dd(fdd,q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40, &
4086  q51,q30,q41,q52,mm02,mm12,mm22,mm32,mm42,mm52,rank,id)
4087  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
4088 
4089  tn2uv = 0d0
4090  cnt = 0
4091  do r=0,rank
4092  do n0=r/2,0,-1
4093  do n1=r-2*n0,0,-1
4094  do n2=r-2*n0-n1,0,-1
4095  do n3=r-2*n0-n1-n2,0,-1
4096  do n4=r-2*n0-n1-n2-n3,0,-1
4097  n5 = r-2*n0-n1-n2-n3-n4
4098 
4099  cnt = cnt+1
4100  tn2(cnt) = fdd(n0,n1,n2,n3,n4,n5)
4101 
4102  end do
4103  end do
4104  end do
4105  end do
4106  end do
4107  end do
4108 
4109 
4110  case(7:)
4111 
4112  call seterrflag_cll(-10)
4113  call errout_cll('TN_cll','N-point functions not implemented in DD library for N>=7',eflag)
4114  if(eflag) then
4115  write(nerrout_cll,*) 'TN_cll: N-point functions not implemented in DD library for N>=7'
4116  write(nerrout_cll,*) 'TN_cll: --> use COLI implementation (mode_cll=1)'
4117  end if
4118 
4119  end select
4120 
4121  if (n.le.6) then
4122  norm_coli = abs(tn(1))
4123  norm_dd = abs(tn2(1))
4124  do r=1,rmax
4125  do i=ncoefs(r,n)-binomtable(r,r+n-2)+1,ncoefs(r,n)
4126  norm_coli = max(norm_coli,abs(tn(i)))
4127  norm_dd = max(norm_dd,abs(tn2(i)))
4128  end do
4129  end do
4130 
4131  if (norm_coli.eq.0d0) then
4132  norm_coli = max(maxval(abs(mominv(1:binomtable(2,n)))), &
4133  maxval(abs(masses2(0:n-1))))
4134  if(norm_coli.ne.0d0) then
4135  norm_coli=1d0/norm_coli**(n-2)
4136  else
4137  norm_coli=1d0/muir2_cll**(n-2)
4138  end if
4139  end if
4140  if (norm_dd.eq.0d0) then
4141  norm_dd = max(maxval(abs(mominv(1:binomtable(2,n)))), &
4142  maxval(abs(masses2(0:n-1))))
4143  if(norm_dd.ne.0d0) then
4144  norm_dd=1d0/norm_dd**(n-2)
4145  else
4146  norm_dd=1d0/muir2_cll**(n-2)
4147  end if
4148  end if
4149  norm = min(norm_coli,norm_dd)
4150 
4151  ! cross-check
4152  call checkcoefstn_cll(tn,tn2,mominv,masses2,n,rmax,norm,tndiff)
4153 
4154  if (tnerraux(rmax).lt.accabsdd(rmax)) then
4155  if (present(tnerr)) tnerr = max(tnerraux,tndiff)
4156  if (present(tnerr2)) tnerr2 = tnerr2aux
4157  if (norm_coli.ne.0d0) then
4158  tnacc = max(tnerraux/norm_coli,tndiff/norm)
4159  tnacc2 = tnerr2aux/norm_coli
4160  else
4161  tnacc = tndiff
4162  tnacc2 = 0d0
4163  end if
4164  if (monitoring) pointscnttn_coli(n) = pointscnttn_coli(n) + 1
4165  else
4166  tn = tn2
4167  tnuv = tn2uv
4168  if (present(tnerr)) tnerr = max(accabsdd(0:rmax),tndiff)
4169  if (present(tnerr2)) tnerr2 = accabs2dd(0:rmax)
4170  if (norm_dd.ne.0d0) then
4171  tnacc = max(accabsdd(0:rmax)/norm_dd,tndiff/norm)
4172  tnacc2 = accabs2dd(0:rmax)/norm_dd
4173  else
4174  tnacc = tndiff
4175  tnacc2 = 0d0
4176  end if
4177  if (monitoring) pointscnttn_dd(n) = pointscnttn_dd(n) + 1
4178  end if
4179 
4180  else
4181 
4182  norm = abs(tn(1))
4183  do r=1,rmax
4184  do i=ncoefs(r,n)-binomtable(r,r+n-2)+1,ncoefs(r,n)
4185  norm = max(norm,abs(tn(i)))
4186  end do
4187  end do
4188  if (norm.eq.0d0) then
4189  norm = max(maxval(abs(mominv(1:binomtable(2,n)))), &
4190  maxval(abs(masses2(0:n-1))))
4191  if(norm.ne.0d0) then
4192  norm=1d0/norm**(n-2)
4193  else
4194  norm=1d0/muir2_cll**(n-2)
4195  end if
4196  end if
4197  if (present(tnerr)) tnerr = tnerraux
4198  if (present(tnerr2)) tnerr2 = tnerr2aux
4199 
4200  if (norm.ne.0d0) then
4201  tnacc = tnerraux/norm
4202  tnacc2 = tnerr2aux/norm
4203  else
4204  tnacc = 0d0
4205  tnacc2 = 0d0
4206  end if
4207  if (monitoring) pointscnttn_coli(n) = pointscnttn_coli(n) + 1
4208 
4209  end if
4210 
4211  if (mflag) call propagateaccflag_cll(tnacc,rmax)
4212 
4213  end select
4214 
4215  if (mflag) call propagateerrflag_cll
4216 
4217  if (monitoring) then
4218  pointscnttn_cll(n) = pointscnttn_cll(n) + 1
4219 
4220  if(maxval(tnacc).gt.reqacc_cll) accpointscnttn_cll(n) = accpointscnttn_cll(n) + 1
4221 
4222  if(maxval(tnacc).gt.critacc_cll) then
4223  critpointscnttn_cll(n) = critpointscnttn_cll(n) + 1
4224  if ( critpointscnttn_cll(n).le.noutcritpointsmax_cll(n) ) then
4225  call critpointsout_cll('TN_cll',n,maxval(tnacc),critpointscnttn_cll(n))
4226  if( critpointscnttn_cll(n).eq.noutcritpointsmax_cll(n)) then
4227  write(ncpout_cll,*) ' Further output of Critical Points for TN_cll suppressed for N =',n
4228  write(ncpout_cll,*)
4229  endif
4230  end if
4231  end if
4232 
4233 
4234 #ifdef CritPoints2
4235  if(maxval(tnacc2).gt.reqacc_cll) accpointscnttn2_cll(n) = accpointscnttn2_cll(n) + 1
4236 
4237  if(maxval(tnacc2).gt.critacc_cll) then
4238  critpointscnttn2_cll(n) = critpointscnttn2_cll(n) + 1
4239  if ( critpointscnttn2_cll(n).le.noutcritpointsmax_cll(n) ) then
4240  call critpointsout2_cll('TN_cll',n,maxval(tnacc2),critpointscnttn2_cll(n))
4241  if( critpointscnttn2_cll(n).eq.noutcritpointsmax_cll(n)) then
4242  write(ncpout2_cll,*) ' Further output of Critical Points for TN_cll suppressed for N =',n
4243  write(ncpout2_cll,*)
4244  endif
4245  end if
4246  end if
4247 #endif
4248  end if
4249 
4250  end subroutine tn_main_checked_cll
4251 
4252 
4253 
4254 
4255 
4256  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4257  ! subroutine T1_cll(A,Auv,masses2,N,rmax,Aerr,id_in)
4258  !
4259  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4260 
4261  subroutine t1_cll(A,Auv,masses2,N,rmax,Aerr,id_in)
4262 
4263  integer, intent(in) :: N,rmax
4264  double complex, intent(in) :: masses2(0:0)
4265  double complex, intent(out) :: A(:)
4266  double complex, intent(out) :: Auv(:)
4267  integer, optional, intent(in) :: id_in
4268  double precision, optional, intent(out) :: Aerr(0:rmax)
4269  logical :: eflag
4270 
4271  if (n.ne.1) then
4272  call seterrflag_cll(-10)
4273  call errout_cll('TN_cll','subroutine called with inconsistent arguments',eflag)
4274  return
4275  end if
4276  if (n.gt.nmax_cll) then
4277  call seterrflag_cll(-10)
4278  call errout_cll('TN_cll','argument N larger than Nmax_cll',eflag,.true.)
4279  write(nerrout_cll,*) 'N =',n
4280  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
4281  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= ',n
4282  call propagateerrflag_cll
4283  return
4284  end if
4285  if (rmax.gt.rmax_cll) then
4286  call seterrflag_cll(-10)
4287  call errout_cll('TN_cll','argument rmax larger than rmax_cll',eflag,.true.)
4288  write(nerrout_cll,*) 'rmax =',rmax
4289  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
4290  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
4291  call propagateerrflag_cll
4292  return
4293  end if
4294 
4295  call t1_checked_cll(a,auv,masses2,n,rmax,aerr,id_in)
4296 
4297  end subroutine t1_cll
4298 
4299 
4300  subroutine t1_checked_cll(A,Auv,masses2,N,rmax,Aerr,id_in)
4301 
4302  integer, intent(in) :: N,rmax
4303  double complex, intent(in) :: masses2(0:0)
4304  double complex, intent(out) :: A(NCoefs(rmax,1))
4305  double complex, intent(out) :: Auv(NCoefs(rmax,1))
4306  integer, optional, intent(in) :: id_in
4307  double precision, optional, intent(out) :: Aerr(0:rmax)
4308  double complex :: mm02
4309  double complex :: A2(NCoefs(rmax,1)),A2uv(NCoefs(rmax,1))
4310  double complex :: Adduv(0:rmax/2),Add(0:rmax/2)
4311  double complex :: elimcminf2
4312  double precision :: Aerraux(0:rmax),Aerr2aux(0:rmax),Adiff(0:rmax)
4313  double complex :: args(1),MomInvDummy(0)
4314  integer :: n0,r,i,cnt,rank,errflag
4315  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD)
4316  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
4317  double precision :: Aacc(0:rmax),norm,norm_coli,norm_dd
4318  integer :: accflagDD,errflagDD,rankDD,NDD,id
4319  logical :: mflag,eflag
4320 
4321 ! if (N.ne.1) then
4322 ! call SetErrFlag_cll(-10)
4323 ! call ErrOut_cll('TN_cll','subroutine called with inconsistent arguments',eflag)
4324 ! return
4325 ! end if
4326 
4327  mflag=.true.
4328  if (present(id_in)) then
4329  mflag=.false.
4330  id = id_in
4331  else
4332  id = 0
4333  end if
4334 
4335  if (mflag) then
4336  args(1) = masses2(0)
4337  call setmasterfname_cll('TN_cll')
4338  call setmastern_cll(n)
4339  call setmasterr_cll(rmax)
4340  call setmasterargs_cll(1,args)
4341 
4342  call settencache_cll(never_tenred_cll)
4343  end if
4344 
4345 
4346  select case (mode_cll)
4347 
4348  case (1)
4349  ! calculate loop integral using
4350  ! COLI implementation by AD/LH
4351 
4352  call calca(a,auv,masses2(0),rmax,aerraux)
4353  if (abs(a(1)).ne.0d0) then
4354  aacc=aerraux/abs(a(1))
4355  else
4356  aacc=0d0
4357  end if
4358  if (present(aerr)) aerr=aerraux
4359  if (mflag) call propagateaccflag_cll(aacc,rmax)
4360 
4361 
4362  case (2)
4363  ! calculate loop integral using
4364  ! DD implementation by SD
4365 
4366  id=0
4367 
4368  ! replace small masses by DD-identifiers
4369  mm02 = getminf2dd_cll(masses2(0))
4370 
4371  rank = rmax
4372  call a_dd(add,adduv,mm02,rank,id)
4373 
4374  do n0=0,rank/2
4375  a(n0+1) = add(n0)
4376  auv(n0+1) = adduv(n0)
4377  end do
4378 
4379  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
4380 
4381  if (present(aerr)) aerr(0:rmax) = accabsdd(0:rmax)
4382 
4383  if (abs(a(1)).ne.0d0) then
4384  aacc=accabsdd(0:rmax)/abs(a(1))
4385  else
4386  aacc=0d0
4387  end if
4388  if (mflag) call propagateaccflag_cll(aacc,rmax)
4389 
4390  case (3)
4391  ! cross-check mode
4392  ! compare results for loop integral
4393  ! from COLI implementation by AD/LH and
4394  ! from DD implementation by SD
4395 
4396  ! calculate loop integral using COLI
4397  call calca(a,auv,masses2(0),rmax,aerraux)
4398 
4399  ! calculate loop integral using DD
4400  id=0
4401 
4402  ! replace small masses by DD-identifiers
4403  mm02 = getminf2dd_cll(masses2(0))
4404 
4405  rank = rmax
4406  call a_dd(add,adduv,mm02,rank,id)
4407  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
4408 
4409  do n0=0,rank/2
4410  a2(n0+1) = add(n0)
4411  a2uv(n0+1) = adduv(n0)
4412  end do
4413 
4414 
4415  ! cross-check
4416 
4417  norm_coli = abs(a(1))
4418  if(norm_coli.eq.0d0) norm_coli = muuv2_cll
4419  norm_dd = abs(a2(1))
4420  if(norm_coli.eq.0d0) norm_dd = muuv2_cll
4421  norm = min(norm_coli,norm_dd)
4422 
4423  call checkcoefsa_cll(a,a2,masses2(0),rmax,norm,adiff)
4424 
4425  if (aerraux(rmax).lt.accabsdd(rmax)) then
4426  if (present(aerr)) aerr = max(aerraux,adiff)
4427  aacc = max(aerraux/norm_coli,adiff/norm)
4428  if (monitoring) pointscnttn_coli(1) = pointscnttn_coli(1) + 1
4429  else
4430  a = a2
4431  auv = a2uv
4432  if (present(aerr)) aerr = max(accabsdd(0:rmax),adiff)
4433  aacc = max(accabsdd(0:rmax)/norm_dd,adiff/norm)
4434  if (monitoring) pointscnttn_dd(1) = pointscnttn_dd(1) + 1
4435  end if
4436 
4437  if (mflag) call propagateaccflag_cll(aacc,rmax)
4438 
4439  end select
4440 
4441  if (mflag) call propagateerrflag_cll
4442 
4443  if (monitoring) then
4444  pointscnttn_cll(1) = pointscnttn_cll(1) + 1
4445 
4446  if(maxval(aacc).gt.reqacc_cll) accpointscnttn_cll(1) = accpointscnttn_cll(1) + 1
4447 
4448  if(maxval(aacc).gt.critacc_cll) then
4449  critpointscnttn_cll(1) = critpointscnttn_cll(1) + 1
4450  if ( critpointscnttn_cll(1).le.noutcritpointsmax_cll(1) ) then
4451  call critpointsout_cll('TN_cll',n,maxval(aacc),critpointscnttn_cll(1))
4452  if( critpointscnttn_cll(1).eq.noutcritpointsmax_cll(1)) then
4453  write(ncpout_cll,*) ' Further output of Critical Points for TN_cll suppressed for N =',1
4454  write(ncpout_cll,*)
4455  endif
4456  end if
4457  end if
4458 
4459  end if
4460 
4461  end subroutine t1_checked_cll
4462 
4463 
4464 
4465 
4466 
4467  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4468  ! subroutine A0_cll(A0,m02)
4469  !
4470  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4471 
4472  subroutine a0_cll(A0,m02)
4473 
4474  double complex, intent(in) :: m02
4475  double complex, intent(out) :: A0
4476  double complex :: mm02
4477  double complex :: A2uv(0:0),A2(0:0),A0_coli
4478  double complex :: Auv(0:0),A(0:0)
4479  double precision :: Adiff(0:0)
4480  double complex :: Adduv(0:0)
4481  double complex :: Add(0:0)
4482  double complex :: args(1)
4483  double precision :: norm
4484  integer :: errflag
4485 
4486  ! set ID of master call
4487  args(1) = m02
4488  call setmasterfname_cll('A0_cll')
4489  call setmastern_cll(1)
4490  call setmasterr_cll(0)
4491  call setmasterargs_cll(1,args)
4492 
4493 
4494  select case (mode_cll)
4495 
4496  case (1)
4497  ! calculate loop integral using
4498  ! COLI implementation by AD/LH
4499 
4500  a0 = a0_coli(m02)
4501 
4502 
4503  case (2)
4504  ! calculate loop integral using
4505  ! DD implementation by SD
4506 
4507  ! replace small masses by DD-identifiers
4508  mm02 = getminf2dd_cll(m02)
4509 
4510  call a_dd(add,adduv,mm02,0,0)
4511  a0 = add(0)
4512 
4513 
4514  case (3)
4515  ! cross-check mode
4516  ! compare results for loop integral
4517  ! from COLI implementation by AD/LH and
4518  ! from DD implementation by SD
4519 
4520  ! calculate loop integral using COLI
4521  a0 = a0_coli(m02)
4522 
4523  ! replace small masses by DD-identifiers
4524  mm02 = getminf2dd_cll(m02)
4525 
4526  call a_dd(add,adduv,mm02,0,0)
4527  a2(0) = add(0)
4528 
4529  ! cross-check
4530  a(0) = a0
4531  norm=max(abs(a(0)),abs(a2(0)))
4532  call checkcoefsa_cll(a,a2,m02,0,norm,adiff)
4533 
4534 
4535  end select
4536 
4537  call propagateerrflag_cll
4538 
4539 
4540  end subroutine a0_cll
4541 
4542 
4543 
4544 
4545 
4546 
4547  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4548  ! subroutine B0_main_cll(B0,p10,m02,m12)
4549  !
4550  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4551 
4552  subroutine b0_main_cll(B0,p10,m02,m12)
4553 
4554  double complex, intent(in) :: p10,m02,m12
4555  double precision :: q10
4556  double complex :: mm02,mm12
4557  double complex, intent(out) :: B0
4558  double complex :: B2uv(0:0,0:0),B2(0:0,0:0),Bn_coli
4559  double complex :: Buv(0:0,0:0),B(0:0,0:0)
4560  double precision :: Bdiff(0:0)
4561  double complex :: Bdduv(0:0,0:0)
4562  double complex :: Bdd(0:0,0:0)
4563  double complex :: args(3)
4564  double precision :: norm
4565  integer :: errflag
4566 
4567  ! set ID of master call
4568  args(1) = p10
4569  args(2) = m02
4570  args(3) = m12
4571  call setmasterfname_cll('B0_cll')
4572  call setmastern_cll(2)
4573  call setmasterr_cll(0)
4574  call setmasterargs_cll(3,args)
4575 
4576 
4577  select case (mode_cll)
4578 
4579  case (1)
4580  ! calculate loop integral using
4581  ! COLI implementation by AD/LH
4582 
4583 ! B0uv = 1d0
4584  b0 = bn_coli(0,p10,m02,m12)
4585 
4586 
4587  case (2)
4588  ! calculate loop integral using
4589  ! DD implementation by SD
4590 
4591  ! replace small masses by DD-identifiers
4592  q10 = dreal(getminf2dd_cll(p10))
4593  mm02 = getminf2dd_cll(m02)
4594  mm12 = getminf2dd_cll(m12)
4595 
4596  use_cache_system=.false.
4597  call b_dd(bdd,bdduv,q10,mm02,mm12,0,0)
4598  use_cache_system=use_cache_system_save
4599 ! B0uv = Bdduv(0,0)
4600  b0 = bdd(0,0)
4601 
4602 
4603  case (3)
4604  ! cross-check mode
4605  ! compare results for loop integral
4606  ! from COLI implementation by AD/LH and
4607  ! from DD implementation by SD
4608 
4609  ! calculate loop integral using COLI
4610 ! B0uv = 1d0
4611  b0 = bn_coli(0,p10,m02,m12)
4612 
4613  ! replace small masses by DD-identifiers
4614  q10 = dreal(getminf2dd_cll(p10))
4615  mm02 = getminf2dd_cll(m02)
4616  mm12 = getminf2dd_cll(m12)
4617 
4618  use_cache_system=.false.
4619  call b_dd(bdd,bdduv,q10,mm02,mm12,0,0)
4620  use_cache_system=use_cache_system_save
4621  b2uv(0,0) = bdduv(0,0)
4622  b2(0,0) = bdd(0,0)
4623 
4624  ! cross-check
4625  b(0,0) = b0
4626  norm=max(abs(b(0,0)),abs(b2(0,0)))
4627  call checkcoefsb_cll(b,b2,p10,m02,m12,0,norm,bdiff)
4628 
4629 
4630  end select
4631 
4632  call propagateerrflag_cll
4633 
4634 
4635  end subroutine b0_main_cll
4636 
4637 
4638 
4639 
4640 
4641  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4642  ! subroutine B0_arrays_cll(B0,MomInv,masses2)
4643  !
4644  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4645 
4646  subroutine b0_arrays_cll(B0,MomInv,masses2)
4647 
4648  double complex, intent(in) :: MomInv(1), masses2(0:1)
4649  double complex, intent(out) :: B0
4650 
4651  call b0_main_cll(b0,mominv(1),masses2(0),masses2(1))
4652 
4653  end subroutine b0_arrays_cll
4654 
4655 
4656 
4657 
4658 
4659  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4660  ! subroutine C0_main_cll(C0,p10,p21,p20,m02,m12,m22)
4661  !
4662  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4663 
4664  subroutine c0_main_cll(C0,p10,p21,p20,m02,m12,m22)
4665 
4666  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
4667  double precision :: q10,q21,q20
4668  double complex :: mm02,mm12,mm22
4669  double complex, intent(out) :: C0
4670  double complex :: C(0:0,0:0,0:0),C2(0:0,0:0,0:0),C0_coli,C0dd
4671  double complex args(6)
4672  double precision :: Cdiff(0:0)
4673  double precision :: norm
4674  integer :: errflag
4675 
4676  ! set ID of master call
4677  args(1) = p10
4678  args(2) = p21
4679  args(3) = p20
4680  args(4) = m02
4681  args(5) = m12
4682  args(6) = m22
4683  call setmasterfname_cll('C0_cll')
4684  call setmastern_cll(2)
4685  call setmasterr_cll(0)
4686  call setmasterargs_cll(6,args)
4687 
4688 
4689  ! write(*,*) 'master call: C_cll'
4690  select case (mode_cll)
4691 
4692  case (1)
4693  ! calculate loop integral using
4694  ! COLI implementation by AD/LH
4695  c0 = c0_coli(p10,p21,p20,m02,m12,m22)
4696 
4697 
4698  case (2)
4699  ! calculate loop integral using
4700  ! DD implementation by SD
4701 
4702  ! replace small masses by DD-identifiers
4703  q10 = dreal(getminf2dd_cll(p10))
4704  q21 = dreal(getminf2dd_cll(p21))
4705  q20 = dreal(getminf2dd_cll(p20))
4706  mm02 = getminf2dd_cll(m02)
4707  mm12 = getminf2dd_cll(m12)
4708  mm22 = getminf2dd_cll(m22)
4709 
4710  c0 = c0dd(q10,q21,q20,mm02,mm12,mm22,0)
4711 
4712 
4713  case (3)
4714  ! cross-check mode
4715  ! compare results for loop integral
4716  ! from COLI implementation by AD/LH and
4717  ! from DD implementation by SD
4718 
4719  ! calculate loop integral using COLI
4720  c0 = c0_coli(p10,p21,p20,m02,m12,m22)
4721 
4722 
4723  ! replace small masses by DD-identifiers
4724  q10 = dreal(getminf2dd_cll(p10))
4725  q21 = dreal(getminf2dd_cll(p21))
4726  q20 = dreal(getminf2dd_cll(p20))
4727  mm02 = getminf2dd_cll(m02)
4728  mm12 = getminf2dd_cll(m12)
4729  mm22 = getminf2dd_cll(m22)
4730 
4731  c2(0,0,0) = c0dd(q10,q21,q20,mm02,mm12,mm22,0)
4732 
4733  ! cross-check
4734  c(0,0,0)=c0
4735  norm=max(abs(c(0,0,0)),abs(c2(0,0,0)))
4736  call checkcoefsc_cll(c,c2,p10,p21,p20,m02,m12,m22,0,norm,cdiff)
4737 
4738 
4739  end select
4740 
4741  call propagateerrflag_cll
4742 
4743 
4744  end subroutine c0_main_cll
4745 
4746 
4747 
4748 
4749 
4750  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4751  ! subroutine C0_arrays_cll(C0,MomInv,masses2,rmax)
4752  !
4753  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4754 
4755  subroutine c0_arrays_cll(C0,MomInv,masses2)
4756 
4757  double complex, intent(in) :: MomInv(3), masses2(0:2)
4758  double complex, intent(out) :: C0
4759 
4760  call c0_main_cll(c0,mominv(1),mominv(2),mominv(3), &
4761  masses2(0),masses2(1),masses2(2))
4762 
4763  end subroutine c0_arrays_cll
4764 
4765 
4766 
4767 
4768 
4769  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4770  ! subroutine D0_main_cll(D0,p10,p21,p32,p30,p20,p31, &
4771  ! m02,m12,m22,m32)
4772  !
4773  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4774 
4775  subroutine d0_main_cll(D0,p10,p21,p32,p30,p20,p31, &
4776  m02,m12,m22,m32)
4777 
4778  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
4779  double precision :: q10,q21,q32,q30,q20,q31
4780  double complex :: mm02,mm12,mm22,mm32
4781  double complex, intent(out) :: D0
4782  double complex :: D2(0:0,0:0,0:0,0:0),D0_coli,D0dd
4783  double complex :: D(0:0,0:0,0:0,0:0)
4784  double complex :: args(10)
4785  double precision :: Ddiff(0:0)
4786  double precision :: norm
4787  integer :: errflag
4788 
4789  ! set ID of master call
4790  args(1) = p10
4791  args(2) = p21
4792  args(3) = p32
4793  args(4) = p30
4794  args(5) = p20
4795  args(6) = p31
4796  args(7) = m02
4797  args(8) = m12
4798  args(9) = m22
4799  args(10) = m32
4800  call setmasterfname_cll('D0_cll')
4801  call setmastern_cll(4)
4802  call setmasterr_cll(0)
4803  call setmasterargs_cll(10,args)
4804 
4805 
4806  select case (mode_cll)
4807 
4808  case (1)
4809  ! calculate loop integral using
4810  ! COLI implementation by AD/LH
4811  d0 = d0_coli(p10,p21,p32,p30,p20,p31,m02,m12,m22,m32)
4812 
4813 
4814  case (2)
4815  ! calculate loop integral using
4816  ! DD implementation by SD
4817 
4818  ! replace small masses by DD-identifiers
4819  q10 = dreal(getminf2dd_cll(p10))
4820  q21 = dreal(getminf2dd_cll(p21))
4821  q32 = dreal(getminf2dd_cll(p32))
4822  q30 = dreal(getminf2dd_cll(p30))
4823  q20 = dreal(getminf2dd_cll(p20))
4824  q31 = dreal(getminf2dd_cll(p31))
4825  mm02 = getminf2dd_cll(m02)
4826  mm12 = getminf2dd_cll(m12)
4827  mm22 = getminf2dd_cll(m22)
4828  mm32 = getminf2dd_cll(m32)
4829 
4830  d0 = d0dd(q10,q21,q32,q30,q20,q31,mm02,mm12,mm22,mm32,0)
4831 
4832 
4833  case (3)
4834  ! cross-check mode
4835  ! compare results for loop integral
4836  ! from COLI implementation by AD/LH and
4837  ! from DD implementation by SD
4838 
4839  ! calculate loop integral using COLI
4840  d0 = d0_coli(p10,p21,p32,p30,p20,p31,m02,m12,m22,m32)
4841 
4842  ! calculate loop integral using DD
4843 
4844  ! replace small masses by DD-identifiers
4845  q10 = dreal(getminf2dd_cll(p10))
4846  q21 = dreal(getminf2dd_cll(p21))
4847  q32 = dreal(getminf2dd_cll(p32))
4848  q30 = dreal(getminf2dd_cll(p30))
4849  q20 = dreal(getminf2dd_cll(p20))
4850  q31 = dreal(getminf2dd_cll(p31))
4851  mm02 = getminf2dd_cll(m02)
4852  mm12 = getminf2dd_cll(m12)
4853  mm22 = getminf2dd_cll(m22)
4854  mm32 = getminf2dd_cll(m32)
4855 
4856  d2(0,0,0,0) = d0dd(q10,q21,q32,q30,q20,q31,mm02,mm12,mm22,mm32,0)
4857 
4858  ! cross-check
4859  d(0,0,0,0)=d0
4860  norm=max(abs(d(0,0,0,0)),abs(d2(0,0,0,0)))
4861  call checkcoefsd_cll(d,d2,p10,p21,p32,p30,p20,p31, &
4862  m02,m12,m22,m32,0,norm,ddiff)
4863 
4864 
4865  end select
4866 
4867  call propagateerrflag_cll
4868 
4869 
4870  end subroutine d0_main_cll
4871 
4872 
4873 
4874 
4875 
4876  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4877  ! subroutine D0_arrays_cll(D0,MomInv,masses2)
4878  !
4879  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4880 
4881  subroutine d0_arrays_cll(D0,MomInv,masses2)
4882 
4883  double complex, intent(in) :: MomInv(6), masses2(0:3)
4884  double complex, intent(out) :: D0
4885 
4886  call d0_main_cll(d0,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
4887  masses2(0),masses2(1),masses2(2),masses2(3))
4888 
4889  end subroutine d0_arrays_cll
4890 
4891 
4892 
4893 
4894 
4895 
4896 
4897  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4898  ! subroutine E0_main_cll(E0,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
4899  ! m02,m12,m22,m32,m42,Eerr,Eerr2)
4900  !
4901  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4902 
4903  subroutine e0_main_cll(E0,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
4904  m02,m12,m22,m32,m42,Eerr,Eerr2)
4905 
4906  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
4907  double complex, intent(in) :: m02,m12,m22,m32,m42
4908  double complex, intent(out) :: E0
4909  double precision, optional, intent(out) :: Eerr(0:0),Eerr2(0:0)
4910  double precision :: Eerraux(0:0),Eerr2aux(0:0),Ediff(0:0)
4911  double precision :: q10,q21,q32,q43,q40,q20,q31,q42,q30,q41
4912  double complex :: mm02,mm12,mm22,mm32,mm42
4913  double complex :: E(0:0,0:0,0:0,0:0,0:0)
4914  double complex :: Euv(0:0,0:0,0:0,0:0,0:0)
4915  double complex :: E2uv(0:0,0:0,0:0,0:0,0:0)
4916  double complex :: E2(0:0,0:0,0:0,0:0,0:0)
4917  double complex :: Edd(0:0,0:0,0:0,0:0,0:0)
4918  double complex :: elimcminf2
4919  double complex :: args(15)
4920  double precision :: norm
4921  integer, parameter :: rank=0
4922 
4923  ! set ID of master call
4924  args(1) = p10
4925  args(2) = p21
4926  args(3) = p32
4927  args(4) = p43
4928  args(5) = p40
4929  args(6) = p20
4930  args(7) = p31
4931  args(8) = p42
4932  args(9) = p30
4933  args(10) = p41
4934  args(11) = m02
4935  args(12) = m12
4936  args(13) = m22
4937  args(14) = m32
4938  args(15) = m42
4939  call setmasterfname_cll('E0_cll')
4940  call setmastern_cll(5)
4941  call setmasterr_cll(0)
4942  call setmasterargs_cll(15,args)
4943 
4944  call settencache_cll(never_tenred_cll)
4945 
4946  select case (mode_cll)
4947 
4948  case (1)
4949  ! calculate loop integral using
4950  ! COLI implementation by AD/LH
4951 
4952  if (present(eerr)) then
4953  if (present(eerr2)) then
4954  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
4955  m02,m12,m22,m32,m42,rank,0,eerr,eerr2)
4956  else
4957  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
4958  m02,m12,m22,m32,m42,rank,0,eerr,eerr2aux)
4959  end if
4960  else
4961  if (present(eerr2)) then
4962  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
4963  m02,m12,m22,m32,m42,rank,0,eerraux,eerr2)
4964  else
4965  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
4966  m02,m12,m22,m32,m42,rank,0,eerraux,eerr2aux)
4967  end if
4968  end if
4969  e0 = e(0,0,0,0,0)
4970 
4971  case (2)
4972  ! calculate loop integral using
4973  ! DD implementation by SD
4974 
4975  ! replace small masses by DD-identifiers
4976  q10 = dreal(getminf2dd_cll(p10))
4977  q21 = dreal(getminf2dd_cll(p21))
4978  q32 = dreal(getminf2dd_cll(p32))
4979  q43 = dreal(getminf2dd_cll(p43))
4980  q40 = dreal(getminf2dd_cll(p40))
4981  q20 = dreal(getminf2dd_cll(p20))
4982  q31 = dreal(getminf2dd_cll(p31))
4983  q42 = dreal(getminf2dd_cll(p42))
4984  q30 = dreal(getminf2dd_cll(p30))
4985  q41 = dreal(getminf2dd_cll(p41))
4986  mm02 = getminf2dd_cll(m02)
4987  mm12 = getminf2dd_cll(m12)
4988  mm22 = getminf2dd_cll(m22)
4989  mm32 = getminf2dd_cll(m32)
4990  mm42 = getminf2dd_cll(m42)
4991 
4992  call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
4993  mm02,mm12,mm22,mm32,mm42,rank,0)
4994  e0 = edd(0,0,0,0,0)
4995 
4996  case (3)
4997  ! cross-check mode
4998  ! compare results for loop integral
4999  ! from COLI implementation by AD/LH and
5000  ! from DD implementation by SD
5001 
5002  ! calculate loop integral
5003  if (present(eerr)) then
5004  if (present(eerr2)) then
5005  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
5006  m02,m12,m22,m32,m42,rank,0,eerr,eerr2)
5007  else
5008  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
5009  m02,m12,m22,m32,m42,rank,0,eerr,eerr2aux)
5010  end if
5011  else
5012  if (present(eerr2)) then
5013  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
5014  m02,m12,m22,m32,m42,rank,0,eerraux,eerr2)
5015  else
5016  call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
5017  m02,m12,m22,m32,m42,rank,0,eerraux,eerr2aux)
5018  end if
5019  end if
5020  e0 = e(0,0,0,0,0)
5021 
5022  ! calculate loop integral
5023 
5024  ! replace small masses by DD-identifiers
5025  q10 = dreal(getminf2dd_cll(p10))
5026  q21 = dreal(getminf2dd_cll(p21))
5027  q32 = dreal(getminf2dd_cll(p32))
5028  q43 = dreal(getminf2dd_cll(p43))
5029  q40 = dreal(getminf2dd_cll(p40))
5030  q20 = dreal(getminf2dd_cll(p20))
5031  q31 = dreal(getminf2dd_cll(p31))
5032  q42 = dreal(getminf2dd_cll(p42))
5033  q30 = dreal(getminf2dd_cll(p30))
5034  q41 = dreal(getminf2dd_cll(p41))
5035  mm02 = getminf2dd_cll(m02)
5036  mm12 = getminf2dd_cll(m12)
5037  mm22 = getminf2dd_cll(m22)
5038  mm32 = getminf2dd_cll(m32)
5039  mm42 = getminf2dd_cll(m42)
5040 
5041  call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
5042  mm02,mm12,mm22,mm32,mm42,rank,0)
5043 
5044  e2(0,0,0,0,0) = edd(0,0,0,0,0)
5045  e2uv = 0d0
5046 
5047  norm=max(abs(e(0,0,0,0,0)),abs(e2(0,0,0,0,0)))
5048 
5049  ! cross-check
5050  call checkcoefse_cll(e,e2,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
5051  m02,m12,m22,m32,m42,rank,norm,ediff)
5052 
5053  end select
5054 
5055  call propagateerrflag_cll
5056 
5057 
5058  end subroutine e0_main_cll
5059 
5060 
5061 
5062 
5063 
5064  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5065  ! subroutine E0_arrays_cll(E0,MomInv,masses2)
5066  !
5067  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5068 
5069  subroutine e0_arrays_cll(E0,MomInv,masses2)
5070 
5071  double complex, intent(in) :: MomInv(10), masses2(0:4)
5072  double complex, intent(out) :: E0
5073 
5074  call e0_main_cll(e0,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
5075  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
5076  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4))
5077 
5078  end subroutine e0_arrays_cll
5079 
5080 
5081 
5082 
5083 
5084 
5085 
5086  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5087  ! subroutine F0_main_cll(F0,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5088  ! p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,Ferr,Ferr2)
5089  !
5090  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5091 
5092  subroutine f0_main_cll(F0,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5093  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,Ferr,Ferr2)
5094 
5095  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
5096  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
5097  double complex, intent(out) :: F0
5098  double precision, optional, intent(out) :: Ferr(0:0),Ferr2(0:0)
5099  double precision :: Ferraux(0:0),Ferr2aux(0:0),Fdiff(0:0)
5100  double precision :: q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40
5101  double precision :: q51,q30,q41,q52
5102  double complex :: mm02,mm12,mm22,mm32,mm42,mm52
5103  integer, parameter :: rmax=0, rank=0
5104  double complex :: F(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5105  double complex :: Fuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5106  double complex :: F2uv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5107  double complex :: F2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5108  double complex :: Fdd(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5109  double complex :: elimcminf2
5110  double complex :: args(21)
5111  double precision :: norm
5112 
5113  ! set ID of master call
5114  args(1) = p10
5115  args(2) = p21
5116  args(3) = p32
5117  args(4) = p43
5118  args(5) = p54
5119  args(6) = p50
5120  args(7) = p20
5121  args(8) = p31
5122  args(9) = p42
5123  args(10) = p53
5124  args(11) = p40
5125  args(12) = p51
5126  args(13) = p30
5127  args(14) = p41
5128  args(15) = p52
5129  args(16) = m02
5130  args(17) = m12
5131  args(18) = m22
5132  args(19) = m32
5133  args(20) = m42
5134  args(21) = m52
5135  call setmasterfname_cll('F0_cll')
5136  call setmastern_cll(6)
5137  call setmasterr_cll(rmax)
5138  call setmasterargs_cll(21,args)
5139 
5140 ! write(*,*) 'F_main_cll mode',mode_cll
5141 
5142  select case (mode_cll)
5143 
5144  case (1)
5145  ! calculate loop integral using
5146  ! COLI implementation by AD/LH
5147 
5148  if (present(ferr)) then
5149  if (present(ferr2)) then
5150  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5151  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,0,0,ferr,ferr2)
5152  else
5153  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5154  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,0,ferr,ferr2aux)
5155  endif
5156  else
5157  if (present(ferr2)) then
5158  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5159  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,0,ferraux,ferr2)
5160  else
5161  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5162  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,0,ferraux,ferr2aux)
5163  end if
5164  endif
5165  f0 = f(0,0,0,0,0,0)
5166 
5167  case (2)
5168  ! calculate loop integral using
5169  ! DD implementation by SD
5170 
5171  ! replace small masses by DD-identifiers
5172  q10 = dreal(getminf2dd_cll(p10))
5173  q21 = dreal(getminf2dd_cll(p21))
5174  q32 = dreal(getminf2dd_cll(p32))
5175  q43 = dreal(getminf2dd_cll(p43))
5176  q54 = dreal(getminf2dd_cll(p54))
5177  q50 = dreal(getminf2dd_cll(p50))
5178  q20 = dreal(getminf2dd_cll(p20))
5179  q31 = dreal(getminf2dd_cll(p31))
5180  q42 = dreal(getminf2dd_cll(p42))
5181  q53 = dreal(getminf2dd_cll(p53))
5182  q40 = dreal(getminf2dd_cll(p40))
5183  q51 = dreal(getminf2dd_cll(p51))
5184  q30 = dreal(getminf2dd_cll(p30))
5185  q41 = dreal(getminf2dd_cll(p41))
5186  q52 = dreal(getminf2dd_cll(p52))
5187  mm02 = getminf2dd_cll(m02)
5188  mm12 = getminf2dd_cll(m12)
5189  mm22 = getminf2dd_cll(m22)
5190  mm32 = getminf2dd_cll(m32)
5191  mm42 = getminf2dd_cll(m42)
5192  mm52 = getminf2dd_cll(m52)
5193 
5194  call f_dd(fdd,q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40, &
5195  q51,q30,q41,q52,mm02,mm12,mm22,mm32,mm42,mm52,rank,0)
5196 
5197  f0 = fdd(0,0,0,0,0,0)
5198 
5199  case (3)
5200  ! cross-check mode
5201  ! compare results for loop integral
5202  ! from COLI implementation by AD/LH and
5203  ! from DD implementation by SD
5204 
5205  ! calculate loop integral
5206  if (present(ferr)) then
5207  if (present(ferr2)) then
5208  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5209  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,0,ferr,ferr2)
5210  else
5211  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5212  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,0,ferr,ferr2aux)
5213  endif
5214  else
5215  if (present(ferr2)) then
5216  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5217  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,0,ferraux,ferr2)
5218  else
5219  call calcf(f,fuv,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5220  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,0,ferraux,ferr2aux)
5221  end if
5222  end if
5223  f0 = f(0,0,0,0,0,0)
5224 
5225  ! replace small masses by DD-identifiers
5226  q10 = dreal(getminf2dd_cll(p10))
5227  q21 = dreal(getminf2dd_cll(p21))
5228  q32 = dreal(getminf2dd_cll(p32))
5229  q43 = dreal(getminf2dd_cll(p43))
5230  q54 = dreal(getminf2dd_cll(p54))
5231  q50 = dreal(getminf2dd_cll(p50))
5232  q20 = dreal(getminf2dd_cll(p20))
5233  q31 = dreal(getminf2dd_cll(p31))
5234  q42 = dreal(getminf2dd_cll(p42))
5235  q53 = dreal(getminf2dd_cll(p53))
5236  q40 = dreal(getminf2dd_cll(p40))
5237  q51 = dreal(getminf2dd_cll(p51))
5238  q30 = dreal(getminf2dd_cll(p30))
5239  q41 = dreal(getminf2dd_cll(p41))
5240  q52 = dreal(getminf2dd_cll(p52))
5241  mm02 = getminf2dd_cll(m02)
5242  mm12 = getminf2dd_cll(m12)
5243  mm22 = getminf2dd_cll(m22)
5244  mm32 = getminf2dd_cll(m32)
5245  mm42 = getminf2dd_cll(m42)
5246  mm52 = getminf2dd_cll(m52)
5247 
5248  call f_dd(fdd,q10,q21,q32,q43,q54,q50,q20,q31,q42,q53,q40, &
5249  q51,q30,q41,q52,mm02,mm12,mm22,mm32,mm42,mm52,rank,0)
5250  f2(0,0,0,0,0,0) = fdd(0,0,0,0,0,0)
5251 
5252  norm=max(abs(f(0,0,0,0,0,0)),abs(f2(0,0,0,0,0,0)))
5253 
5254  ! cross-check
5255  call checkcoefsf_cll(f,f2,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
5256  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,norm,fdiff)
5257 
5258  end select
5259 
5260  call propagateerrflag_cll
5261 
5262 
5263  end subroutine f0_main_cll
5264 
5265 
5266 
5267 
5268  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5269  ! subroutine F0_arrays_cll(F0,MomInv,masses2)
5270  !
5271  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5272 
5273  subroutine f0_arrays_cll(F0,MomInv,masses2)
5274 
5275  double complex, intent(in) :: MomInv(15), masses2(0:5)
5276  double complex, intent(out) :: F0
5277 
5278  call f0_main_cll(f0,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
5279  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10), &
5280  mominv(11),mominv(12),mominv(13),mominv(14),mominv(15), &
5281  masses2(0),masses2(1),masses2(2),masses2(3),masses2(4),masses2(5))
5282 
5283  end subroutine f0_arrays_cll
5284 
5285 
5286 
5287 
5288 
5289  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5290  ! subroutine DB0_main_cll(DB0,p10,m02,m12)
5291  !
5292  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5293 
5294  subroutine db0_main_cll(DB0,p10,m02,m12)
5295 
5296  double complex, intent(in) :: p10,m02,m12
5297  double precision :: q10
5298  double complex :: mm02,mm12
5299  double complex, intent(out) :: DB0
5300  double complex :: DB0dd, DB1dd
5301  double complex :: DB0_coli
5302  double complex :: args(3)
5303  double complex :: DBdduv(0:0,0:0)
5304  double complex :: DBdd(0:0,0:0)
5305  integer :: errflag
5306 
5307  ! set ID of master call
5308  args(1) = p10
5309  args(2) = m02
5310  args(3) = m12
5311  call setmasterfname_cll('DB0_cll')
5312  call setmastern_cll(2)
5313  call setmasterr_cll(0)
5314  call setmasterargs_cll(3,args)
5315 
5316 
5317  select case (mode_cll)
5318 
5319  case (1)
5320  ! calculate loop integral using
5321  ! COLI implementation by AD/LH
5322 
5323  db0 = db0_coli(p10,m02,m12)
5324 
5325 
5326  case (2)
5327  ! calculate loop integral using
5328  ! DD implementation by SD
5329 
5330  ! replace small masses by DD-identifiers
5331  q10 = dreal(getminf2dd_cll(p10))
5332  mm02 = getminf2dd_cll(m02)
5333  mm12 = getminf2dd_cll(m12)
5334 
5335  use_cache_system=.false.
5336  call db_dd(dbdd,dbdduv,q10,mm02,mm12,0)
5337  use_cache_system=use_cache_system_save
5338  db0 = dbdd(0,0)
5339 
5340  case (3)
5341  ! cross-check mode
5342  ! compare results for loop integral
5343  ! from COLI implementation by AD/LH and
5344  ! from DD implementation by SD
5345 
5346  ! calculate loop integral using COLI
5347  db0 = db0_coli(p10,m02,m12)
5348 
5349 
5350  ! replace small masses by DD-identifiers
5351  q10 = dreal(getminf2dd_cll(p10))
5352  mm02 = getminf2dd_cll(m02)
5353  mm12 = getminf2dd_cll(m12)
5354 
5355  use_cache_system=.false.
5356  call db_dd(dbdd,dbdduv,q10,mm02,mm12,0)
5357  use_cache_system=use_cache_system_save
5358  db0dd = dbdd(0,0)
5359 
5360  ! cross-check
5361  call checkcoefsdbr_cll(db0,db0dd,p10,m02,m12,0)
5362 
5363 
5364  end select
5365 
5366  call propagateerrflag_cll
5367 
5368 
5369  end subroutine db0_main_cll
5370 
5371 
5372 
5373 
5374 
5375  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5376  ! subroutine DB0_arrays_cll(DB0,MomInv,masses2)
5377  !
5378  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5379 
5380  subroutine db0_arrays_cll(DB0,MomInv,masses2)
5381 
5382  double complex, intent(in) :: MomInv(1), masses2(0:1)
5383  double complex, intent(out) :: DB0
5384 
5385  call db0_main_cll(db0,mominv(1),masses2(0),masses2(1))
5386 
5387  end subroutine db0_arrays_cll
5388 
5389 
5390 
5391 
5392 
5393  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5394  ! subroutine DB1_main_cll(DB1,p10,m02,m12)
5395  !
5396  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5397 
5398  subroutine db1_main_cll(DB1,p10,m02,m12)
5399 
5400  double complex, intent(in) :: p10,m02,m12
5401  double precision :: q10
5402  double complex :: mm02,mm12
5403  double complex, intent(out) :: DB1
5404  double complex :: DB0dd, DB1dd
5405  double complex :: DB1_coli
5406  double complex :: args(3)
5407  double complex :: DBdduv(0:1,0:1)
5408  double complex :: DBdd(0:1,0:1)
5409  integer :: errflag
5410 
5411  ! set ID of master call
5412  args(1) = p10
5413  args(2) = m02
5414  args(3) = m12
5415  call setmasterfname_cll('DB1_cll')
5416  call setmastern_cll(2)
5417  call setmasterr_cll(1)
5418  call setmasterargs_cll(3,args)
5419 
5420 
5421  select case (mode_cll)
5422 
5423  case (1)
5424  ! calculate loop integral using
5425  ! COLI implementation by AD/LH
5426 
5427  db1 = db1_coli(p10,m02,m12)
5428 
5429 
5430  case (2)
5431  ! calculate loop integral using
5432  ! DD implementation by SD
5433 
5434  ! replace small masses by DD-identifiers
5435  q10 = dreal(getminf2dd_cll(p10))
5436  mm02 = getminf2dd_cll(m02)
5437  mm12 = getminf2dd_cll(m12)
5438 
5439  use_cache_system=.false.
5440  call db_dd(dbdd,dbdduv,q10,mm02,mm12,1)
5441  use_cache_system=use_cache_system_save
5442  db1 = dbdd(0,1)
5443 
5444 
5445  case (3)
5446  ! cross-check mode
5447  ! compare results for loop integral
5448  ! from COLI implementation by AD/LH and
5449  ! from DD implementation by SD
5450 
5451  ! calculate loop integral using COLI
5452  db1 = db1_coli(p10,m02,m12)
5453 
5454  ! replace small masses by DD-identifiers
5455  q10 = dreal(getminf2dd_cll(p10))
5456  mm02 = getminf2dd_cll(m02)
5457  mm12 = getminf2dd_cll(m12)
5458 
5459  use_cache_system=.false.
5460  call db_dd(dbdd,dbdduv,q10,mm02,mm12,1)
5461  use_cache_system=use_cache_system_save
5462  db1dd = dbdd(0,1)
5463 
5464  ! cross-check
5465  call checkcoefsdbr_cll(db1,db1dd,p10,m02,m12,1)
5466 
5467 
5468  end select
5469 
5470  call propagateerrflag_cll
5471 
5472 
5473  end subroutine db1_main_cll
5474 
5475 
5476 
5477 
5478 
5479  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5480  ! subroutine DB1_arrays_cll(DB1,MomInv,masses2)
5481  !
5482  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5483 
5484  subroutine db1_arrays_cll(DB1,MomInv,masses2)
5485 
5486  double complex, intent(in) :: MomInv(1), masses2(0:1)
5487  double complex, intent(out) :: DB1
5488 
5489  call db1_main_cll(db1,mominv(1),masses2(0),masses2(1))
5490 
5491  end subroutine db1_arrays_cll
5492 
5493 
5494 
5495 
5496 
5497  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5498  ! subroutine DB00_main_cll(DB00,DB00uv,p10,m02,m12)
5499  !
5500  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5501 
5502  subroutine db00_main_cll(DB00,DB00uv,p10,m02,m12)
5503 
5504  double complex, intent(in) :: p10,m02,m12
5505  double precision :: q10
5506  double complex :: mm02,mm12
5507  double complex, intent(out) :: DB00, DB00uv
5508  double complex :: DB00dd, DB00dduv
5509  double complex :: DB00_coli
5510  double complex :: args(3)
5511  double complex :: DBdduv(0:2,0:2)
5512  double complex :: DBdd(0:2,0:2)
5513  integer :: errflag
5514 
5515  ! set ID of master call
5516  args(1) = p10
5517  args(2) = m02
5518  args(3) = m12
5519  call setmasterfname_cll('DB00_cll')
5520  call setmastern_cll(2)
5521  call setmasterr_cll(2)
5522  call setmasterargs_cll(3,args)
5523 
5524 
5525  select case (mode_cll)
5526 
5527  case (1)
5528  ! calculate loop integral using
5529  ! COLI implementation by AD/LH
5530 
5531  db00uv = -1d0/12d0
5532  db00 = db00_coli(p10,m02,m12)
5533 
5534 
5535  case (2)
5536  ! calculate loop integral using
5537  ! DD implementation by SD
5538 
5539  ! replace small masses by DD-identifiers
5540  q10 = dreal(getminf2dd_cll(p10))
5541  mm02 = getminf2dd_cll(m02)
5542  mm12 = getminf2dd_cll(m12)
5543 
5544  use_cache_system=.false.
5545  call db_dd(dbdd,dbdduv,q10,mm02,mm12,2)
5546  use_cache_system=use_cache_system_save
5547  db00uv = dbdduv(1,0)
5548  db00 = dbdd(1,0)
5549 
5550  case (3)
5551  ! cross-check mode
5552  ! compare results for loop integral
5553  ! from COLI implementation by AD/LH and
5554  ! from DD implementation by SD
5555 
5556  db00uv = -1d0/12d0
5557 
5558  ! calculate loop integral using COLI
5559  db00 = db00_coli(p10,m02,m12)
5560 
5561 
5562  ! replace small masses by DD-identifiers
5563  q10 = dreal(getminf2dd_cll(p10))
5564  mm02 = getminf2dd_cll(m02)
5565  mm12 = getminf2dd_cll(m12)
5566 
5567  use_cache_system=.false.
5568  call db_dd(dbdd,dbdduv,q10,mm02,mm12,2)
5569  use_cache_system=use_cache_system_save
5570  db00dduv = dbdduv(1,0)
5571  db00dd = dbdd(1,0)
5572 
5573  ! cross-check
5574  call checkcoefsdbr_cll(db00,db00dd,p10,m02,m12,2)
5575 
5576 
5577  end select
5578 
5579  call propagateerrflag_cll
5580 
5581 
5582  end subroutine db00_main_cll
5583 
5584 
5585 
5586 
5587 
5588  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5589  ! subroutine DB00_arrays_cll(DB00,DB00uv,MomInv,masses2)
5590  !
5591  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5592 
5593  subroutine db00_arrays_cll(DB00,DB00uv,MomInv,masses2)
5594 
5595  double complex, intent(in) :: MomInv(1), masses2(0:1)
5596  double complex, intent(out) :: DB00uv,DB00
5597 
5598  call db00_main_cll(db00,db00uv,mominv(1),masses2(0),masses2(1))
5599 
5600  end subroutine db00_arrays_cll
5601 
5602 
5603 
5604 
5605 
5606  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5607  ! subroutine DB11_main_cll(DB11,p10,m02,m12)
5608  !
5609  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5610 
5611  subroutine db11_main_cll(DB11,p10,m02,m12)
5612 
5613  double complex, intent(in) :: p10,m02,m12
5614  double precision :: q10,DBerraux(0:2)
5615  double complex :: mm02,mm12
5616  double complex, intent(out) :: DB11
5617  double complex :: DB11dd
5618  double complex :: args(3)
5619  double complex :: DBcoliuv(0:1,0:1), DBcoli(0:1,0:2)
5620  double complex :: DBdduv(0:2,0:2)
5621  double complex :: DBdd(0:2,0:2)
5622  integer :: errflag
5623 
5624  ! set ID of master call
5625  args(1) = p10
5626  args(2) = m02
5627  args(3) = m12
5628  call setmasterfname_cll('DB11_cll')
5629  call setmastern_cll(2)
5630  call setmasterr_cll(2)
5631  call setmasterargs_cll(3,args)
5632 
5633 
5634  select case (mode_cll)
5635 
5636  case (1)
5637  ! calculate loop integral using
5638  ! COLI implementation by AD/LH
5639 
5640  use_cache_system=.false.
5641  call calcdb(dbcoli,dbcoliuv,p10,m02,m12,2,0,dberraux)
5642  use_cache_system=use_cache_system_save
5643  db11 = dbcoli(0,2)
5644 
5645 
5646  case (2)
5647  ! calculate loop integral using
5648  ! DD implementation by SD
5649 
5650  ! replace small masses by DD-identifiers
5651  q10 = dreal(getminf2dd_cll(p10))
5652  mm02 = getminf2dd_cll(m02)
5653  mm12 = getminf2dd_cll(m12)
5654 
5655  use_cache_system=.false.
5656  call db_dd(dbdd,dbdduv,q10,mm02,mm12,2)
5657  use_cache_system=use_cache_system_save
5658  db11 = dbdd(0,2)
5659 
5660  case (3)
5661  ! cross-check mode
5662  ! compare results for loop integral
5663  ! from COLI implementation by AD/LH and
5664  ! from DD implementation by SD
5665 
5666  ! calculate loop integral using COLI
5667  use_cache_system=.false.
5668  call calcdb(dbcoli,dbcoliuv,p10,m02,m12,2,0,dberraux)
5669  use_cache_system=use_cache_system_save
5670  db11 = dbcoli(0,2)
5671 
5672  ! replace small masses by DD-identifiers
5673  q10 = dreal(getminf2dd_cll(p10))
5674  mm02 = getminf2dd_cll(m02)
5675  mm12 = getminf2dd_cll(m12)
5676 
5677  use_cache_system=.false.
5678  call db_dd(dbdd,dbdduv,q10,mm02,mm12,2)
5679  use_cache_system=use_cache_system_save
5680  db11dd = dbdd(0,2)
5681 
5682  ! cross-check
5683  call checkcoefsdbr_cll(db11,db11dd,p10,m02,m12,2)
5684 
5685 
5686  end select
5687 
5688  call propagateerrflag_cll
5689 
5690 
5691  end subroutine db11_main_cll
5692 
5693 
5694 
5695 
5696 
5697  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5698  ! subroutine DB11_arrays_cll(DB11,MomInv,masses2)
5699  !
5700  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5701 
5702  subroutine db11_arrays_cll(DB11,MomInv,masses2)
5703 
5704  double complex, intent(in) :: MomInv(1), masses2(0:1)
5705  double complex, intent(out) :: DB11
5706 
5707  call db11_main_cll(db11,mominv(1),masses2(0),masses2(1))
5708 
5709  end subroutine db11_arrays_cll
5710 
5711 
5712 
5713 
5714 
5715  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5716  ! subroutine DB_main_cll(DB,DBuv,p10,m02,m12,rmax,DBerr)
5717  !
5718  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5719 
5720  subroutine db_main_cll(DB,DBuv,p10,m02,m12,rmax,DBerr)
5721 
5722  integer, intent(in) :: rmax
5723  double complex, intent(in) :: p10,m02,m12
5724  double precision :: q10
5725  double complex :: mm02,mm12
5726  double complex, intent(out) :: DBuv(0:rmax/2,0:rmax)
5727  double complex, intent(out) :: DB(0:rmax/2,0:rmax)
5728  double precision, optional, intent(out) :: DBerr(0:rmax)
5729  double precision :: DBerraux(0:rmax),DBdiff(0:rmax)
5730  double complex :: DB2uv(0:rmax/2,0:rmax), DB2(0:rmax/2,0:rmax)
5731  double complex :: DBcoliuv(0:rmax/2,0:rmax)
5732  double complex :: DBcoli(0:rmax/2,0:rmax)
5733  double complex :: DB0dd,DB1dd
5734  double complex :: args(3)
5735  double complex :: DBdduv(0:rmax,0:rmax)
5736  double complex :: DBdd(0:rmax,0:rmax)
5737  double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD)
5738  double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
5739  double precision :: DBacc(0:rmax),DBacc2(0:rmax),norm,norm_coli,norm_dd
5740  integer :: accflagDD,errflagDD,NDD,rankDD
5741  integer :: n0,rank,errflag,i0,i1,n
5742  logical :: flag = .true.,eflag
5743 
5744 ! write(*,*) 'DB_main in',p10,m02,m12,rmax
5745 
5746  ! set ID of master call
5747  args(1) = p10
5748  args(2) = m02
5749  args(3) = m12
5750  call setmasterfname_cll('DB_cll')
5751  call setmastern_cll(2)
5752  call setmasterr_cll(rmax)
5753  call setmasterargs_cll(3,args)
5754 
5755  select case (mode_cll)
5756 
5757  case (1)
5758  ! calculate loop integral using
5759  ! COLI implementation by AD/LH
5760 
5761  if (present(dberr)) then
5762  call calcdb(dbcoli,dbcoliuv,p10,m02,m12,rmax,0,dberr)
5763  else
5764  call calcdb(dbcoli,dbcoliuv,p10,m02,m12,rmax,0,dberraux)
5765  end if
5766  db(0:rmax/2,0:rmax) = dbcoli(0:rmax/2,0:rmax)
5767  dbuv(0:rmax/2,0:rmax) = dbcoliuv(0:rmax/2,0:rmax)
5768 
5769  case (2)
5770  ! calculate loop integral using
5771  ! DD implementation by SD
5772 
5773  ! replace small masses by DD-identifiers
5774  q10 = dreal(getminf2dd_cll(p10))
5775  mm02 = getminf2dd_cll(m02)
5776  mm12 = getminf2dd_cll(m12)
5777 
5778  rank = rmax
5779 
5780  ! use_cache_system=.false.
5781  call db_dd(dbdd,dbdduv,q10,mm02,mm12,rank)
5782  ! use_cache_system=use_cache_system_save
5783 
5784  db(0:rank/2,0:rank) = dbdd(0:rank/2,0:rank)
5785  dbuv(0:rank/2,0:rank) = dbdduv(0:rank/2,0:rank)
5786 
5787  case (3)
5788  ! cross-check mode
5789  ! compare results for loop integral
5790  ! from COLI implementation by AD/LH and
5791  ! from DD implementation by SD
5792 
5793  ! calculate loop integral using COLI
5794  call calcdb(dbcoli,dbcoliuv,p10,m02,m12,rmax,0,dberraux)
5795  db(0:rmax/2,0:rmax) = dbcoli(0:rmax/2,0:rmax)
5796  dbuv(0:rmax/2,0:rmax) = dbcoliuv(0:rmax/2,0:rmax)
5797 
5798  ! calculate loop integral using DD
5799 
5800  ! replace small masses by DD-identifiers
5801  q10 = dreal(getminf2dd_cll(p10))
5802  mm02 = getminf2dd_cll(m02)
5803  mm12 = getminf2dd_cll(m12)
5804 
5805  rank = rmax
5806 
5807  ! use_cache_system=.false.
5808  call db_dd(dbdd,dbdduv,q10,mm02,mm12,rank)
5809  ! use_cache_system=use_cache_system_save
5810 
5811  db2(0:rank/2,0:rank) = dbdd(0:rank/2,0:rank)
5812  db2uv(0:rank/2,0:rank) = dbdduv(0:rank/2,0:rank)
5813  call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,0)
5814 
5815  norm_coli = maxval(abs(db(0,0:rmax)))
5816  norm_dd = maxval(abs(db2(0,0:rmax)))
5817  if (norm_coli.eq.0d0) then
5818  norm_coli = max(abs(p10),abs(m02),abs(m12))
5819  if(norm_coli.ne.0d0) then
5820  norm_coli=1d0/norm_coli
5821  else
5822  norm_coli=1d0/muir2_cll
5823  end if
5824  end if
5825  if (norm_dd.eq.0d0) then
5826  norm_dd = max(abs(p10),abs(m02),abs(m12))
5827  if(norm_dd.ne.0d0) then
5828  norm_dd=1d0/norm_dd
5829  else
5830  norm_dd=1d0/muir2_cll
5831  end if
5832  end if
5833  norm = min(norm_coli,norm_dd)
5834 
5835  ! cross-check
5836  call checkcoefsdb_cll(db,db2,p10,m02,m12,rank,norm,dbdiff)
5837 
5838  if (dberraux(rmax).lt.accabsdd(rmax)) then
5839  if (present(dberr)) dberr = max(dberraux,dbdiff)
5840  dbacc = max(dberraux/norm_coli,dbdiff/norm)
5841  if (monitoring) pointscntdb_coli = pointscntdb_coli + 1
5842  else
5843  db = db2
5844  dbuv = db2uv
5845  if (present(dberr)) dberr = max(accabsdd(0:rmax),dbdiff)
5846  dbacc = max(accabsdd(0:rmax)/norm_dd,dbdiff/norm)
5847  if (monitoring) pointscntdb_dd = pointscntdb_dd + 1
5848  end if
5849 
5850  call propagateaccflag_cll(dbacc,rmax)
5851 
5852  end select
5853 
5854  call propagateerrflag_cll
5855 
5856  if (monitoring) then
5857  pointscntdb_cll = pointscntdb_cll + 1
5858 
5859  if(maxval(dbacc).gt.reqacc_cll) accpointscntdb_cll = accpointscntdb_cll + 1
5860 
5861  if(maxval(dbacc).gt.critacc_cll) then
5862  critpointscntdb_cll = critpointscntdb_cll + 1
5863  if ( critpointscntdb_cll.le.noutcritpointsmaxdb_cll ) then
5864  call critpointsout_cll('DB_cll',0,maxval(dbacc), critpointscntdb_cll)
5865  if( critpointscntdb_cll.eq.noutcritpointsmaxdb_cll) then
5866  write(ncpout_cll,*) ' Further output of Critical Points for DB_cll suppressed '
5867  write(ncpout_cll,*)
5868  endif
5869  end if
5870  end if
5871 
5872  end if
5873 
5874 
5875  end subroutine db_main_cll
5876 
5877 
5878 
5879  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5880  ! subroutine DB_arrays_cll(DB,DBuv,MomInv,masses2,rmax,DBerr)
5881  !
5882  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5883 
5884  subroutine db_arrays_cll(DB,DBuv,MomInv,masses2,rmax,DBerr)
5885 
5886  integer, intent(in) :: rmax
5887  double complex, intent(in) :: MomInv(1), masses2(0:1)
5888  double complex, intent(out) :: DBuv(0:rmax/2,0:rmax)
5889  double complex, intent(out) :: DB(0:rmax/2,0:rmax)
5890  double precision, optional, intent(out) :: DBerr(0:rmax)
5891  double precision :: DBerraux(0:rmax)
5892 
5893  if (present(dberr)) then
5894  call db_main_cll(db,dbuv,mominv(1),masses2(0),masses2(1),rmax,dberr)
5895  else
5896  call db_main_cll(db,dbuv,mominv(1),masses2(0),masses2(1),rmax,dberraux)
5897  end if
5898 
5899  end subroutine db_arrays_cll
5900 
5901 
5902 end module collier_coefs
collier_coefs::d0_arrays_cll
subroutine d0_arrays_cll(D0, MomInv, masses2)
Definition: collier_coefs.F90:4882
collier_coefs::t1_cll
subroutine t1_cll(A, Auv, masses2, N, rmax, Aerr, id_in)
Definition: collier_coefs.F90:4262
collier_coefs::db00_cll
Definition: collier_coefs.F90:116
collier_coefs::b_arrays_list_cll
subroutine b_arrays_list_cll(B, Buv, MomInv, masses2, rmax, Berr)
Definition: collier_coefs.F90:630
collier_coefs::db11_arrays_cll
subroutine db11_arrays_cll(DB11, MomInv, masses2)
Definition: collier_coefs.F90:5703
collier_coefs::e0_cll
Definition: collier_coefs.F90:96
collier_coefs::db11_main_cll
subroutine db11_main_cll(DB11, p10, m02, m12)
Definition: collier_coefs.F90:5612
collier_global::pointscntd_dd
integer pointscntd_dd
Definition: collier_global.F90:82
collier_coefs::a_cll
subroutine a_cll(A, Auv, m02, rmax, Aerr, id_in)
Definition: collier_coefs.F90:142
collier_coefs::c_arrays_list_cll
subroutine c_arrays_list_cll(C, Cuv, MomInv, masses2, rmax, Cerr, Cerr2)
Definition: collier_coefs.F90:1126
collier_coefs::c_arrays_cll
subroutine c_arrays_cll(C, Cuv, MomInv, masses2, rmax, Cerr, Cerr2)
Definition: collier_coefs.F90:1002
collier_global::accpointscnte_cll
integer accpointscnte_cll
Definition: collier_global.F90:48
collier_coefs::db1_arrays_cll
subroutine db1_arrays_cll(DB1, MomInv, masses2)
Definition: collier_coefs.F90:5485
collier_global::critpointscntf2_cll
integer critpointscntf2_cll
Definition: collier_global.F90:66
collier_global::accpointscntc_cll
integer accpointscntc_cll
Definition: collier_global.F90:48
reductiontn::calctn
subroutine calctn(TN, TNuv, MomInv, masses2, N, rmax, id, TNerr, TNerr2)
Definition: reductionTN.F90:45
collier_global::pointscntc_dd
integer pointscntc_dd
Definition: collier_global.F90:82
collier_global::accpointscntf_cll
integer accpointscntf_cll
Definition: collier_global.F90:48
collier_coefs::d0_main_cll
subroutine d0_main_cll(D0, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32)
Definition: collier_coefs.F90:4777
collier_aux::checkcoefsdb_cll
subroutine checkcoefsdb_cll(DB, DB2, p10, m02, m12, rmax, norm0, DBdiff)
Definition: collier_aux.F90:1406
collier_coefs::db00_arrays_cll
subroutine db00_arrays_cll(DB00, DB00uv, MomInv, masses2)
Definition: collier_coefs.F90:5594
collier_coefs::tn_main_cll
subroutine tn_main_cll(TN, TNuv, MomInv, masses2, N, rmax, TNerr, id_in, TNerr2)
Definition: collier_coefs.F90:3508
collier_global::accpointscntc2_cll
integer accpointscntc2_cll
Definition: collier_global.F90:69
collier_global::never_tenred_cll
integer never_tenred_cll
Definition: collier_global.F90:40
collier_coefs::e_main_cll
subroutine e_main_cll(E, Euv, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, Eerr, id_in, Eerr2)
Definition: collier_coefs.F90:1780
collier_init
Definition: collier_init.F90:26
collier_global::accpointscnte2_cll
integer accpointscnte2_cll
Definition: collier_global.F90:69
collier_coefs::b0_arrays_cll
subroutine b0_arrays_cll(B0, MomInv, masses2)
Definition: collier_coefs.F90:4647
collier_coefs::g_main_cll
subroutine g_main_cll(G, Guv, p10, p21, p32, p43, p54, p65, p60, p20, p31, p42, p53, p64, p50, p61, p30, p41, p52, p63, p40, p51, p62, m02, m12, m22, m32, m42, m52, m62, rmax, Gerr, id_in, Gerr2)
Definition: collier_coefs.F90:3000
collier_coefs
Definition: collier_coefs.F90:28
collier_coefs::f_main_cll
subroutine f_main_cll(F, Fuv, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, Ferr, id_in, Ferr2)
Definition: collier_coefs.F90:2371
collier_coefs::db_arrays_cll
subroutine db_arrays_cll(DB, DBuv, MomInv, masses2, rmax, DBerr)
Definition: collier_coefs.F90:5885
collier_aux::checkcoefse_cll
subroutine checkcoefse_cll(E, E2, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, norm0, Ediff)
Definition: collier_aux.F90:515
reductiontn
Definition: reductionTN.F90:28
collier_global::critpointscntd2_cll
integer critpointscntd2_cll
Definition: collier_global.F90:66
collier_global::accpointscntb_cll
integer accpointscntb_cll
Definition: collier_global.F90:48
collier_global::pointscntdb_dd
integer pointscntdb_dd
Definition: collier_global.F90:82
collier_coefs::b_list_cll
subroutine b_list_cll(B, Buv, p10, m02, m12, rmax, Berr)
Definition: collier_coefs.F90:560
collier_coefs::e_list_cll
subroutine e_list_cll(E, Euv, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, Eerr, Eerr2)
Definition: collier_coefs.F90:2182
collier_coefs::b_list_checked_cll
subroutine b_list_checked_cll(B, Buv, p10, m02, m12, rmax, Berr)
Definition: collier_coefs.F90:592
collier_coefs::c0_arrays_cll
subroutine c0_arrays_cll(C0, MomInv, masses2)
Definition: collier_coefs.F90:4756
collier_coefs::b0_main_cll
subroutine b0_main_cll(B0, p10, m02, m12)
Definition: collier_coefs.F90:4553
collier_coefs::e_arrays_list_cll
subroutine e_arrays_list_cll(E, Euv, MomInv, masses2, rmax, Eerr, Eerr2)
Definition: collier_coefs.F90:2276
collier_aux::checkcoefsb_cll
subroutine checkcoefsb_cll(B, B2, p10, m02, m12, rmax, norm0, Bdiff)
Definition: collier_aux.F90:145
collier_coefs::e_arrays_cll
subroutine e_arrays_cll(E, Euv, MomInv, masses2, rmax, Eerr, Eerr2)
Definition: collier_coefs.F90:2137
collier_global::muuv2_cll
double precision muuv2_cll
Definition: collier_global.F90:28
collier_global::nerrout_cll
integer nerrout_cll
Definition: collier_global.F90:101
collier_coefs::d_arrays_list_checked_cll
subroutine d_arrays_list_checked_cll(D, Duv, MomInv, masses2, rmax, Derr, Derr2)
Definition: collier_coefs.F90:1722
collier_coefs::db0_arrays_cll
subroutine db0_arrays_cll(DB0, MomInv, masses2)
Definition: collier_coefs.F90:5381
collier_coefs::c_list_checked_cll
subroutine c_list_checked_cll(C, Cuv, p10, p21, p20, m02, m12, m22, rmax, Cerr, Cerr2)
Definition: collier_coefs.F90:1071
collier_global::ncheckout_cll
integer ncheckout_cll
Definition: collier_global.F90:102
collier_aux::checkcoefstn_cll
subroutine checkcoefstn_cll(TN, TN2, MomInv, masses2, N, rmax, norm0, TNdiff)
Definition: collier_aux.F90:1094
collier_global::pointscntb_coli
integer pointscntb_coli
Definition: collier_global.F90:76
collier_aux::checkcoefsf_cll
subroutine checkcoefsf_cll(F, F2, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, norm0, Fdiff)
Definition: collier_aux.F90:795
collier_coefs::d_list_cll
subroutine d_list_cll(D, Duv, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, Derr, Derr2)
Definition: collier_coefs.F90:1603
collier_global::critpointscntd_cll
integer critpointscntd_cll
Definition: collier_global.F90:45
collier_coefs::d_list_checked_cll
subroutine d_list_checked_cll(D, Duv, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, Derr, Derr2)
Definition: collier_coefs.F90:1635
collier_global::pointscnte_coli
integer pointscnte_coli
Definition: collier_global.F90:76
collier_global::critpointscnta_cll
integer critpointscnta_cll
Definition: collier_global.F90:45
collier_global::pointscntf_coli
integer pointscntf_coli
Definition: collier_global.F90:76
collier_coefs::db0_cll
Definition: collier_coefs.F90:106
collier_coefs::b_arrays_list_checked_cll
subroutine b_arrays_list_checked_cll(B, Buv, MomInv, masses2, rmax, Berr)
Definition: collier_coefs.F90:661
collier_coefs::f0_arrays_cll
subroutine f0_arrays_cll(F0, MomInv, masses2)
Definition: collier_coefs.F90:5274
collier_global
Definition: collier_global.F90:23
collier_coefs::f_cll
Definition: collier_coefs.F90:64
collier_coefs::e0_arrays_cll
subroutine e0_arrays_cll(E0, MomInv, masses2)
Definition: collier_coefs.F90:5070
collier_coefs::b_main_cll
subroutine b_main_cll(B, Buv, p10, m02, m12, rmax, Berr, id_in)
Definition: collier_coefs.F90:327
collier_global::noutcritpointsmax_cll
integer, dimension(:), allocatable noutcritpointsmax_cll
Definition: collier_global.F90:97
collier_global::accpointscntg_cll
integer accpointscntg_cll
Definition: collier_global.F90:48
collier_global::accpointscntdb_cll
integer accpointscntdb_cll
Definition: collier_global.F90:48
collier_global::pointscnta_cll
integer pointscnta_cll
Definition: collier_global.F90:51
collier_coefs::c0_main_cll
subroutine c0_main_cll(C0, p10, p21, p20, m02, m12, m22)
Definition: collier_coefs.F90:4665
collier_global::muir2_cll
double precision muir2_cll
Definition: collier_global.F90:28
collier_global::critpointscntb_cll
integer critpointscntb_cll
Definition: collier_global.F90:45
collier_global::critpointscntdb_cll
integer critpointscntdb_cll
Definition: collier_global.F90:45
collier_aux::checkcoefsc_cll
subroutine checkcoefsc_cll(C, C2, p10, p21, p20, m02, m12, m22, rmax, norm0, Cdiff)
Definition: collier_aux.F90:259
collier_coefs::a0_cll
subroutine a0_cll(A0, m02)
Definition: collier_coefs.F90:4473
collier_aux::errout_cll
subroutine errout_cll(sub, err, flag, nomaster)
Definition: collier_aux.F90:1555
collier_coefs::d0_cll
Definition: collier_coefs.F90:91
collier_coefs::b_arrays_cll
subroutine b_arrays_cll(B, Buv, MomInv, masses2, rmax, Berr)
Definition: collier_coefs.F90:534
collier_global::pointscnttn_dd
integer, dimension(:), allocatable pointscnttn_dd
Definition: collier_global.F90:84
collier_coefs::f_arrays_cll
subroutine f_arrays_cll(F, Fuv, MomInv, masses2, rmax, Ferr, Ferr2)
Definition: collier_coefs.F90:2755
collier_global::critpointscntg_cll
integer critpointscntg_cll
Definition: collier_global.F90:45
collier_global::noutcritpointsmaxdb_cll
integer noutcritpointsmaxdb_cll
Definition: collier_global.F90:98
collier_coefs::d_cll
Definition: collier_coefs.F90:52
collier_coefs::f0_main_cll
subroutine f0_main_cll(F0, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, Ferr, Ferr2)
Definition: collier_coefs.F90:5094
collier_coefs::g_arrays_list_checked_cll
subroutine g_arrays_list_checked_cll(G, Guv, MomInv, masses2, rmax, Gerr, Gerr2)
Definition: collier_coefs.F90:3433
collier_global::pointscntc_coli
integer pointscntc_coli
Definition: collier_global.F90:76
collier_global::pointscntg_cll
integer pointscntg_cll
Definition: collier_global.F90:51
collier_global::critpointscntc2_cll
integer critpointscntc2_cll
Definition: collier_global.F90:66
collier_coefs::c_cll
Definition: collier_coefs.F90:46
collier_coefs::g_arrays_list_cll
subroutine g_arrays_list_cll(G, Guv, MomInv, masses2, rmax, Gerr, Gerr2)
Definition: collier_coefs.F90:3402
collier_coefs::tn_cll
Definition: collier_coefs.F90:76
collier_global::critpointscntf_cll
integer critpointscntf_cll
Definition: collier_global.F90:45
collier_global::reqacc_cll
double precision reqacc_cll
Definition: collier_global.F90:30
collier_aux::checkcoefsa_cll
subroutine checkcoefsa_cll(A, A2, m02, rmax, norm0, Adiff)
Definition: collier_aux.F90:42
collier_coefs::db1_main_cll
subroutine db1_main_cll(DB1, p10, m02, m12)
Definition: collier_coefs.F90:5399
collier_coefs::e_arrays_list_checked_cll
subroutine e_arrays_list_checked_cll(E, Euv, MomInv, masses2, rmax, Eerr, Eerr2)
Definition: collier_coefs.F90:2307
collier_global::accpointscntd_cll
integer accpointscntd_cll
Definition: collier_global.F90:48
collier_global::accpointscnttn_cll
integer, dimension(:), allocatable accpointscnttn_cll
Definition: collier_global.F90:61
collier_global::pointscntb_cll
integer pointscntb_cll
Definition: collier_global.F90:51
collier_global::critpointscntc_cll
integer critpointscntc_cll
Definition: collier_global.F90:45
collier_global::ncpout2_cll
integer ncpout2_cll
Definition: collier_global.F90:103
collier_global::pointscntdb_cll
integer pointscntdb_cll
Definition: collier_global.F90:51
collier_global::pointscnte_dd
integer pointscnte_dd
Definition: collier_global.F90:82
collier_global::ncpout_cll
integer ncpout_cll
Definition: collier_global.F90:103
collier_coefs::e0_main_cll
subroutine e0_main_cll(E0, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, Eerr, Eerr2)
Definition: collier_coefs.F90:4905
collier_coefs::t1_checked_cll
subroutine t1_checked_cll(A, Auv, masses2, N, rmax, Aerr, id_in)
Definition: collier_coefs.F90:4301
collier_global::pointscnttn_cll
integer, dimension(:), allocatable pointscnttn_cll
Definition: collier_global.F90:61
collier_coefs::g_list_cll
subroutine g_list_cll(G, Guv, p10, p21, p32, p43, p54, p65, p60, p20, p31, p42, p53, p64, p50, p61, p30, p41, p52, p63, p40, p51, p62, m02, m12, m22, m32, m42, m52, m62, rmax, Gerr, Gerr2)
Definition: collier_coefs.F90:3296
collier_global::accpointscnttn2_cll
integer, dimension(:), allocatable accpointscnttn2_cll
Definition: collier_global.F90:74
collier_global::critpointscnte_cll
integer critpointscnte_cll
Definition: collier_global.F90:45
collier_global::accpointscnta_cll
integer accpointscnta_cll
Definition: collier_global.F90:48
collier_global::critpointscnte2_cll
integer critpointscnte2_cll
Definition: collier_global.F90:66
collier_aux::checkcoefsd_cll
subroutine checkcoefsd_cll(D, D2, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, norm0, Ddiff)
Definition: collier_aux.F90:377
collier_coefs::c0_cll
Definition: collier_coefs.F90:86
collier_coefs::db00_main_cll
subroutine db00_main_cll(DB00, DB00uv, p10, m02, m12)
Definition: collier_coefs.F90:5503
collier_global::pointscnte_cll
integer pointscnte_cll
Definition: collier_global.F90:51
collier_coefs::f_list_cll
subroutine f_list_cll(F, Fuv, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, Ferr, Ferr2)
Definition: collier_coefs.F90:2803
collier_global::monitoring
logical monitoring
Definition: collier_global.F90:64
collier_global::mode_cll
integer mode_cll
Definition: collier_global.F90:27
collier_coefs::tn_main_checked_cll
subroutine tn_main_checked_cll(TN, TNuv, MomInv, masses2, N, rmax, TNerr, id_in, TNerr2)
Definition: collier_coefs.F90:3548
collier_init::propagateaccflag_cll
subroutine propagateaccflag_cll(RelErrs, rmax)
Definition: collier_init.F90:2450
collier_global::pointscntd_coli
integer pointscntd_coli
Definition: collier_global.F90:76
collier_coefs::f_arrays_list_cll
subroutine f_arrays_list_cll(F, Fuv, MomInv, masses2, rmax, Ferr, Ferr2)
Definition: collier_coefs.F90:2897
collier_global::pointscntc_cll
integer pointscntc_cll
Definition: collier_global.F90:51
collier_init::getminf2dd_cll
double complex function getminf2dd_cll(m2)
Definition: collier_init.F90:1083
collier_coefs::e_list_checked_cll
subroutine e_list_checked_cll(E, Euv, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, Eerr, Eerr2)
Definition: collier_coefs.F90:2216
collier_global::pointscntdb_coli
integer pointscntdb_coli
Definition: collier_global.F90:76
collier_global::pointscntf_cll
integer pointscntf_cll
Definition: collier_global.F90:51
collier_coefs::db_main_cll
subroutine db_main_cll(DB, DBuv, p10, m02, m12, rmax, DBerr)
Definition: collier_coefs.F90:5721
collier_coefs::db1_cll
Definition: collier_coefs.F90:111
collier_global::pointscntd_cll
integer pointscntd_cll
Definition: collier_global.F90:51
collier_global::critpointscnttn2_cll
integer, dimension(:), allocatable critpointscnttn2_cll
Definition: collier_global.F90:74
collier_coefs::c_main_cll
subroutine c_main_cll(C, Cuv, p10, p21, p20, m02, m12, m22, rmax, Cerr, id_in, Cerr2)
Definition: collier_coefs.F90:699
collier_coefs::d_arrays_list_cll
subroutine d_arrays_list_cll(D, Duv, MomInv, masses2, rmax, Derr, Derr2)
Definition: collier_coefs.F90:1691
collier_global::pointscntb_dd
integer pointscntb_dd
Definition: collier_global.F90:82
collier_global::critacc_cll
double precision critacc_cll
Definition: collier_global.F90:30
collier_init::seterrflag_cll
subroutine seterrflag_cll(val)
Definition: collier_init.F90:2158
collier_coefs::c_list_cll
subroutine c_list_cll(C, Cuv, p10, p21, p20, m02, m12, m22, rmax, Cerr, Cerr2)
Definition: collier_coefs.F90:1040
collier_global::critpointscntg2_cll
integer critpointscntg2_cll
Definition: collier_global.F90:66
collier_coefs::db11_cll
Definition: collier_coefs.F90:121
collier_global::pointscnta_coli
integer pointscnta_coli
Definition: collier_global.F90:76
collier_coefs::f0_cll
Definition: collier_coefs.F90:101
collier_coefs::d_arrays_cll
subroutine d_arrays_cll(D, Duv, MomInv, masses2, rmax, Derr, Derr2)
Definition: collier_coefs.F90:1545
collier_coefs::g_cll
Definition: collier_coefs.F90:70
collier_coefs::d_main_cll
subroutine d_main_cll(D, Duv, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, Derr, id_in, Derr2)
Definition: collier_coefs.F90:1213
collier_aux
Definition: collier_aux.F90:23
collier_global::pointscnta_dd
integer pointscnta_dd
Definition: collier_global.F90:82
collier_coefs::db0_main_cll
subroutine db0_main_cll(DB0, p10, m02, m12)
Definition: collier_coefs.F90:5295
collier_aux::checkcoefsdbr_cll
subroutine checkcoefsdbr_cll(DB, DB2, p10, m02, m12, r)
Definition: collier_aux.F90:1340
collier_global::critpointscnttn_cll
integer, dimension(:), allocatable critpointscnttn_cll
Definition: collier_global.F90:61
collier_coefs::b_cll
Definition: collier_coefs.F90:40
collier_global::pointscntf_dd
integer pointscntf_dd
Definition: collier_global.F90:82
collier_init::propagateerrflag_cll
subroutine propagateerrflag_cll()
Definition: collier_init.F90:2194
collier_coefs::f_arrays_list_checked_cll
subroutine f_arrays_list_checked_cll(F, Fuv, MomInv, masses2, rmax, Ferr, Ferr2)
Definition: collier_coefs.F90:2928
collier_global::accpointscntd2_cll
integer accpointscntd2_cll
Definition: collier_global.F90:69
collier_global::accpointscntg2_cll
integer accpointscntg2_cll
Definition: collier_global.F90:69
collier_coefs::f_list_checked_cll
subroutine f_list_checked_cll(F, Fuv, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, Ferr, Ferr2)
Definition: collier_coefs.F90:2837
collier_aux::critpointsout2_cll
subroutine critpointsout2_cll(sub, N, acc, cntr)
Definition: collier_aux.F90:1650
collier_coefs::g_list_checked_cll
subroutine g_list_checked_cll(G, Guv, p10, p21, p32, p43, p54, p65, p60, p20, p31, p42, p53, p64, p50, p61, p30, p41, p52, p63, p40, p51, p62, m02, m12, m22, m32, m42, m52, m62, rmax, Gerr, Gerr2)
Definition: collier_coefs.F90:3333
collier_coefs::b0_cll
Definition: collier_coefs.F90:81
collier_coefs::c_arrays_list_checked_cll
subroutine c_arrays_list_checked_cll(C, Cuv, MomInv, masses2, rmax, Cerr, Cerr2)
Definition: collier_coefs.F90:1157
collier_coefs::e_cll
Definition: collier_coefs.F90:58
collier_coefs::g_arrays_cll
subroutine g_arrays_cll(G, Guv, MomInv, masses2, rmax, Gerr, Gerr2)
Definition: collier_coefs.F90:3242
collier_aux::critpointsout_cll
subroutine critpointsout_cll(sub, N, acc, cntr)
Definition: collier_aux.F90:1602
collier_global::nmax_cll
integer nmax_cll
Definition: collier_global.F90:44
collier_coefs::db_cll
Definition: collier_coefs.F90:126
collier_global::rmax_cll
integer rmax_cll
Definition: collier_global.F90:44
collier_global::pointscnttn_coli
integer, dimension(:), allocatable pointscnttn_coli
Definition: collier_global.F90:78
collier_global::accpointscntf2_cll
integer accpointscntf2_cll
Definition: collier_global.F90:69