JHUGen MELA  v2.4.1
Matrix element calculations as used in JHUGen. MELA is an important tool that was used for the Higgs boson discovery and for precise measurements of its structure and interactions. Please see the website https://spin.pha.jhu.edu/ and papers cited there for more details, and kindly cite those papers when using this code.
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
Generated by   doxygen 1.8.17