JHUGen MELA  JHUGen v7.5.6, MELA v2.4.2
Matrix element calculations as used in JHUGen.
collier_tensors.F90
Go to the documentation of this file.
1 !!
2 !! File collier_tensors.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_tensors
29 
30  use combinatorics
31  use collier_global
32  use collier_init
33  use collier_aux
34  use collier_coefs
35  use buildtensors
36  use tensorreduction
37  use cache
38 ! use coli_statistics
39 
40  implicit none
41 
42 
43 
44  interface aten_cll
45  module procedure aten_main_cll,aten_list_cll, &
46  aten_args_cll,aten_args_list_cll
47  end interface aten_cll
48 
49 
50  interface bten_cll
51  module procedure bten_main_cll,bten_list_cll, &
52  bten_args_cll,bten_args_list_cll
53  end interface bten_cll
54 
55 
56  interface cten_cll
57  module procedure cten_main_cll,cten_list_cll, &
58  cten_args_cll,cten_args_list_cll
59  end interface cten_cll
60 
61 
62  interface dten_cll
63  module procedure dten_main_cll,dten_list_cll, &
64  dten_args_cll,dten_args_list_cll
65  end interface dten_cll
66 
67 
68  interface eten_cll
69  module procedure eten_main_cll,eten_list_cll, &
70  eten_args_cll,eten_args_list_cll
71  end interface eten_cll
72 
73 
74  interface ften_cll
75  module procedure ften_main_cll,ften_list_cll, &
76  ften_args_cll,ften_args_list_cll
77  end interface ften_cll
78 
79 
80  interface gten_cll
81  module procedure gten_main_cll,gten_list_cll, &
82  gten_args_cll,gten_args_list_cll
83  end interface gten_cll
84 
85 
86  interface tnten_cll
87  module procedure tnten_main_cll,tnten_list_cll, &
88  t1ten_main_cll,t1ten_list_cll
89  end interface tnten_cll
90 
91 
92 
93 
94 
95 contains
96 
97 
98  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
99  ! subroutine Aten_cll(TA,TAuv,masses2,rmax,TAerr)
100  !
101  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
102 
103  subroutine aten_main_cll(TA,TAuv,masses2,rmax,TAerr)
104 
105  integer, intent(in) :: rmax
106  double complex,intent(in) :: masses2(0:0)
107  double complex, intent(out) :: TA(0:rmax,0:rmax,0:rmax,0:rmax)
108  double complex, intent(out) :: TAuv(0:rmax,0:rmax,0:rmax,0:rmax)
109  double precision, intent(out), optional :: TAerr(0:rmax)
110  double complex :: TA2(0:rmax,0:rmax,0:rmax,0:rmax), TAuv2(0:rmax,0:rmax,0:rmax,0:rmax)
111  double complex :: CA(0:rmax/2), CAuv(0:rmax/2)
112  double precision :: CAerr(0:rmax),TAerr_aux(0:rmax),TAerr_aux2(0:rmax)
113  double complex :: args(1)
114  double precision :: TAdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TAacc(0:rmax)
115  integer :: r,n0,n1,n2,n3
116  logical :: eflag
117 
118  if (1.gt.nmax_cll) then
119  call seterrflag_cll(-10)
120  call errout_cll('Aten_cll','Nmax_cll smaller 1',eflag,.true.)
121  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
122  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 1'
123  call propagateerrflag_cll
124  return
125  end if
126  if (rmax.gt.rmax_cll) then
127  call seterrflag_cll(-10)
128  call errout_cll('Aten_cll','argument rmax larger than rmax_cll',eflag,.true.)
129  write(nerrout_cll,*) 'rmax =',rmax
130  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
131  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
132  call propagateerrflag_cll
133  return
134  end if
135 
136  args(1) = masses2(0)
137  call setmasterfname_cll('Aten_cll')
138  call setmastern_cll(1)
139  call setmasterr_cll(rmax)
140  call setmasterargs_cll(1,args)
141 
142  call settencache_cll(tenred_cll-1)
143 
144  if (mode_cll.eq.3) then
145  ! calculate tensor with coefficients from COLI
146  mode_cll = 1
147  call a_cll(ca,cauv,masses2(0),rmax,caerr,0)
148  call calctensora(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
149 
150  ! calculate tensor with coefficients from DD
151  mode_cll = 2
152  call a_cll(ca,cauv,masses2(0),rmax,caerr,0)
153  call calctensora(ta2,tauv2,taerr_aux2,ca,cauv,caerr,rmax)
154 
155  ! comparison --> take better result
156  mode_cll = 3
157  do r=0,rmax
158  norm_coli=0d0
159  norm_dd=0d0
160  do n0=0,r
161  do n1=0,r-n0
162  do n2=0,r-n0-n1
163  n3=r-n0-n1-n2
164  norm_coli = max(norm_coli,abs(ta(n0,n1,n2,n3)))
165  norm_dd = max(norm_dd,abs(ta2(n0,n1,n2,n3)))
166  end do
167  end do
168  end do
169  if (norm_coli.eq.0d0) then
170  norm_coli = abs(masses2(0))
171  if(norm_coli.ne.0d0) then
172  norm_coli=norm_coli**(1+real(r)/2)
173  else
174  norm_coli=muuv2_cll**(1+real(r)/2)
175  end if
176  end if
177  if (norm_dd.eq.0d0) then
178  norm_dd = abs(masses2(0))
179  if(norm_dd.ne.0d0) then
180  norm_dd=norm_dd**(1+real(r)/2)
181  else
182  norm_dd=muuv2_cll**(1+real(r)/2)
183  end if
184  end if
185  norm(r) = min(norm_coli,norm_dd)
186  end do
187 
188  call checktena_cll(ta,ta2,masses2,norm,rmax,tadiff)
189 
190  if (taerr_aux(rmax).lt.taerr_aux2(rmax)) then
191  if (present(taerr)) taerr = max(taerr_aux,tadiff*norm)
192  do r=0,rmax
193  taacc(r) = max(taerr_aux(r)/norm(r),tadiff(r))
194  end do
195  if (monitoring) pointscntaten_coli = pointscntaten_coli + 1
196  else
197  ta = ta2
198  tauv = tauv2
199  if (present(taerr)) taerr = max(taerr_aux2,tadiff*norm)
200  do r=0,rmax
201  taacc(r) = max(taerr_aux2(r)/norm(r),tadiff(r))
202  end do
203  if (monitoring) pointscntaten_dd = pointscntaten_dd + 1
204  end if
205 
206  else
207  call a_cll(ca,cauv,masses2(0),rmax,caerr,0)
208  call calctensora(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
209  if (present(taerr)) taerr = taerr_aux
210  do r=0,rmax
211  norm(r)=0d0
212  do n0=0,r
213  do n1=0,r-n0
214  do n2=0,r-n0-n1
215  n3=r-n0-n1-n2
216  norm(r) = max(norm(r),abs(ta(n0,n1,n2,n3)))
217  end do
218  end do
219  end do
220  if (norm(r).eq.0d0) then
221  norm(r) = abs(masses2(0))
222  if(norm(r).ne.0d0) then
223  norm(r)=norm(r)**(1+real(r)/2)
224  else
225  norm(r)=muuv2_cll**(1+real(r)/2)
226  end if
227  end if
228  end do
229  do r=0,rmax
230  taacc(r) = taerr_aux(r)/norm(r)
231  end do
232 
233  end if
234 
235  call propagateaccflag_cll(taacc,rmax)
236  call propagateerrflag_cll
237 
238  if (monitoring) then
239  pointscntaten_cll = pointscntaten_cll + 1
240 
241  if(maxval(taacc).gt.reqacc_cll) accpointscntaten_cll = accpointscntaten_cll + 1
242 
243  if(maxval(taacc).gt.critacc_cll) then
244  critpointscntaten_cll = critpointscntaten_cll + 1
245  if ( critpointscntaten_cll.le.noutcritpointsmax_cll(1) ) then
246  call critpointsout_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
247  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
248  write(ncpout_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
249  write(ncpout_cll,*)
250  endif
251 #ifdef CritPoints2
252  call critpointsout2_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
253  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
254  write(ncpout2_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
255  write(ncpout2_cll,*)
256  endif
257 #endif
258  end if
259  end if
260  end if
261 
262  end subroutine aten_main_cll
263 
264 
265 
266 
267 
268  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
269  ! subroutine Aten_cll(TA,TAuv,masses2,rmax,TAerr)
270  !
271  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
272 
273  subroutine aten_list_cll(TA,TAuv,masses2,rmax,TAerr)
274 
275  integer, intent(in) :: rmax
276  double complex,intent(in) :: masses2(0:0)
277  double complex, intent(out) :: TA(:),TAuv(:)
278  double precision, intent(out), optional :: TAerr(0:rmax)
279  integer :: r,i
280  logical :: eflag
281 
282  if (1.gt.nmax_cll) then
283  call seterrflag_cll(-10)
284  call errout_cll('Aten_cll','Nmax_cll smaller 1',eflag,.true.)
285  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
286  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 1'
287  call propagateerrflag_cll
288  return
289  end if
290  if (rmax.gt.rmax_cll) then
291  call seterrflag_cll(-10)
292  call errout_cll('Aten_cll','argument rmax larger than rmax_cll',eflag,.true.)
293  write(nerrout_cll,*) 'rmax =',rmax
294  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
295  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
296  call propagateerrflag_cll
297  return
298  end if
299 
300  call aten_list_checked_cll(ta,tauv,masses2,rmax,taerr)
301 
302  end subroutine aten_list_cll
303 
304 
305  subroutine aten_list_checked_cll(TA,TAuv,masses2,rmax,TAerr)
306 
307  integer, intent(in) :: rmax
308  double complex,intent(in) :: masses2(0:0)
309  double complex, intent(out) :: TA(RtS(rmax)),TAuv(RtS(rmax))
310  double precision, intent(out), optional :: TAerr(0:rmax)
311  double complex :: TA2(RtS(rmax)),TAuv2(RtS(rmax))
312  double complex :: CA(0:rmax/2), CAuv(0:rmax/2)
313  double precision :: CAerr(0:rmax), TAerr_aux(0:rmax), TAerr_aux2(0:rmax)
314  double complex :: args(1)
315  double precision :: TAdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TAacc(0:rmax)
316  integer :: r,i
317 
318  args(1) = masses2(0)
319  call setmasterfname_cll('Aten_cll')
320  call setmastern_cll(1)
321  call setmasterr_cll(rmax)
322  call setmasterargs_cll(1,args)
323 
324  call settencache_cll(tenred_cll-1)
325 
326  if (mode_cll.eq.3) then
327  ! calculate tensor with coefficients from COLI
328  mode_cll = 1
329  call a_cll(ca,cauv,masses2(0),rmax,caerr,0)
330  call calctensora_list(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
331 
332  ! calculate tensor with coefficients from DD
333  mode_cll = 2
334  call a_cll(ca,cauv,masses2(0),rmax,caerr,0)
335  call calctensora_list(ta2,tauv2,taerr_aux2,ca,cauv,caerr,rmax)
336 
337  ! comparison --> take better result
338  mode_cll = 3
339  do r=0,rmax
340  norm_coli=0d0
341  norm_dd=0d0
342  do i=rts(r-1)+1,rts(r)
343  norm_coli = max(norm_coli,abs(ta(i)))
344  norm_dd = max(norm_dd,abs(ta2(i)))
345  end do
346  if (norm_coli.eq.0d0) then
347  norm_coli = abs(masses2(0))
348  if(norm_coli.ne.0d0) then
349  norm_coli=norm_coli**(1+real(r)/2)
350  else
351  norm_coli=muuv2_cll**(1+real(r)/2)
352  end if
353  end if
354  if (norm_dd.eq.0d0) then
355  norm_dd = abs(masses2(0))
356  if(norm_dd.ne.0d0) then
357  norm_dd=norm_dd**(1+real(r)/2)
358  else
359  norm_dd=muuv2_cll**(1+real(r)/2)
360  end if
361  end if
362  norm(r) = min(norm_coli,norm_dd)
363  end do
364 
365  call checktenalist_cll(ta,ta2,masses2,norm,rmax,tadiff)
366 
367  if (taerr_aux(rmax).lt.taerr_aux2(rmax)) then
368  if (present(taerr)) taerr = max(taerr_aux,tadiff*norm)
369  do r=0,rmax
370  taacc(r) = max(taerr_aux(r)/norm(r),tadiff(r))
371  end do
372  if (monitoring) pointscntaten_coli = pointscntaten_coli + 1
373  else
374  ta = ta2
375  tauv = tauv2
376  if (present(taerr)) taerr = max(taerr_aux2,tadiff*norm)
377  do r=0,rmax
378  taacc(r) = max(taerr_aux2(r)/norm(r),tadiff(r))
379  end do
380  if (monitoring) pointscntaten_dd = pointscntaten_dd + 1
381  end if
382 
383  else
384  call a_cll(ca,cauv,masses2(0),rmax,caerr,0)
385  call calctensora_list(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
386  if (present(taerr)) taerr = taerr_aux
387  do r=0,rmax
388  norm(r)=0d0
389  do i=rts(r-1)+1,rts(r)
390  norm(r) = max(norm(r),abs(ta(i)))
391  end do
392  if (norm(r).eq.0d0) then
393  norm(r) = abs(masses2(0))
394  if(norm(r).ne.0d0) then
395  norm(r)=norm(r)**(1+real(r)/2)
396  else
397  norm(r)=muuv2_cll**(1+real(r)/2)
398  end if
399  end if
400  end do
401  do r=0,rmax
402  taacc(r) = taerr_aux(r)/norm(r)
403  end do
404 
405  end if
406 
407  call propagateaccflag_cll(taacc,rmax)
408  call propagateerrflag_cll
409 
410  if (monitoring) then
411  pointscntaten_cll = pointscntaten_cll + 1
412 
413  if(maxval(taacc).gt.reqacc_cll) accpointscntaten_cll = accpointscntaten_cll + 1
414 
415  if(maxval(taacc).gt.critacc_cll) then
416  critpointscntaten_cll = critpointscntaten_cll + 1
417  if ( critpointscntaten_cll.le.noutcritpointsmax_cll(1) ) then
418  call critpointsout_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
419  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
420  write(ncpout_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
421  write(ncpout_cll,*)
422  endif
423 #ifdef CritPoints2
424  call critpointsout2_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
425  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
426  write(ncpout2_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
427  write(ncpout2_cll,*)
428  endif
429 #endif
430  end if
431  end if
432  end if
433 
434  end subroutine aten_list_checked_cll
435 
436 
437 
438 
439 
440  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
441  ! subroutine Aten_cll(TA,TAuv,m02,rmax,TAerr)
442  !
443  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
444 
445  subroutine aten_args_cll(TA,TAuv,m02,rmax,TAerr)
446 
447  integer, intent(in) :: rmax
448  double complex,intent(in) :: m02
449  double complex, intent(out) :: TA(0:rmax,0:rmax,0:rmax,0:rmax)
450  double complex, intent(out) :: TAuv(0:rmax,0:rmax,0:rmax,0:rmax)
451  double precision, intent(out), optional :: TAerr(0:rmax)
452  double complex :: TA2(0:rmax,0:rmax,0:rmax,0:rmax), TAuv2(0:rmax,0:rmax,0:rmax,0:rmax)
453  double complex :: CA(0:rmax/2), CAuv(0:rmax/2)
454  double precision :: CAerr(0:rmax),TAerr_aux(0:rmax),TAerr_aux2(0:rmax)
455  double complex :: args(1),masses2(0:0)
456  double precision :: TAdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TAacc(0:rmax)
457  integer :: r,n0,n1,n2,n3
458  logical :: eflag
459 
460  if (1.gt.nmax_cll) then
461  call seterrflag_cll(-10)
462  call errout_cll('Aten_cll','Nmax_cll smaller 1',eflag,.true.)
463  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
464  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 1'
465  call propagateerrflag_cll
466  return
467  end if
468  if (rmax.gt.rmax_cll) then
469  call seterrflag_cll(-10)
470  call errout_cll('Aten_cll','argument rmax larger than rmax_cll',eflag,.true.)
471  write(nerrout_cll,*) 'rmax =',rmax
472  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
473  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
474  call propagateerrflag_cll
475  return
476  end if
477 
478  args(1) = m02
479  masses2(0) = m02
480  call setmasterfname_cll('Aten_cll')
481  call setmastern_cll(1)
482  call setmasterr_cll(rmax)
483  call setmasterargs_cll(1,args)
484 
485  call settencache_cll(tenred_cll-1)
486 
487  if (mode_cll.eq.3) then
488  ! calculate tensor with coefficients from COLI
489  mode_cll = 1
490  call a_cll(ca,cauv,m02,rmax,caerr,0)
491  call calctensora(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
492 
493  ! calculate tensor with coefficients from DD
494  mode_cll = 2
495  call a_cll(ca,cauv,m02,rmax,caerr,0)
496  call calctensora(ta2,tauv2,taerr_aux2,ca,cauv,caerr,rmax)
497 
498  ! comparison --> take better result
499  mode_cll = 3
500  do r=0,rmax
501  norm_coli=0d0
502  norm_dd=0d0
503  do n0=0,r
504  do n1=0,r-n0
505  do n2=0,r-n0-n1
506  n3=r-n0-n1-n2
507  norm_coli = max(norm_coli,abs(ta(n0,n1,n2,n3)))
508  norm_dd = max(norm_dd,abs(ta2(n0,n1,n2,n3)))
509  end do
510  end do
511  end do
512  if (norm_coli.eq.0d0) then
513  norm_coli = abs(masses2(0))
514  if(norm_coli.ne.0d0) then
515  norm_coli=norm_coli**(1+real(r)/2)
516  else
517  norm_coli=muuv2_cll**(1+real(r)/2)
518  end if
519  end if
520  if (norm_dd.eq.0d0) then
521  norm_dd = abs(masses2(0))
522  if(norm_dd.ne.0d0) then
523  norm_dd=norm_dd**(1+real(r)/2)
524  else
525  norm_dd=muuv2_cll**(1+real(r)/2)
526  end if
527  end if
528  norm(r) = min(norm_coli,norm_dd)
529  end do
530 
531  call checktena_cll(ta,ta2,masses2,norm,rmax,tadiff)
532 
533  if (taerr_aux(rmax).lt.taerr_aux2(rmax)) then
534  if (present(taerr)) taerr = max(taerr_aux,tadiff*norm)
535  do r=0,rmax
536  taacc(r) = max(taerr_aux(r)/norm(r),tadiff(r))
537  end do
538  if (monitoring) pointscntaten_coli = pointscntaten_coli + 1
539  else
540  ta = ta2
541  tauv = tauv2
542  if (present(taerr)) taerr = max(taerr_aux2,tadiff*norm)
543  do r=0,rmax
544  taacc(r) = max(taerr_aux2(r)/norm(r),tadiff(r))
545  end do
546  if (monitoring) pointscntaten_dd = pointscntaten_dd + 1
547  end if
548 
549  else
550  call a_cll(ca,cauv,m02,rmax,caerr,0)
551  call calctensora(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
552  if (present(taerr)) taerr = taerr_aux
553  do r=0,rmax
554  norm(r)=0d0
555  do n0=0,r
556  do n1=0,r-n0
557  do n2=0,r-n0-n1
558  n3=r-n0-n1-n2
559  norm(r) = max(norm(r),abs(ta(n0,n1,n2,n3)))
560  end do
561  end do
562  end do
563  if (norm(r).eq.0d0) then
564  norm(r) = abs(masses2(0))
565  if(norm(r).ne.0d0) then
566  norm(r)=norm(r)**(1+real(r)/2)
567  else
568  norm(r)=muuv2_cll**(1+real(r)/2)
569  end if
570  end if
571  end do
572  do r=0,rmax
573  taacc(r) = taerr_aux(r)/norm(r)
574  end do
575 
576  end if
577 
578  call propagateaccflag_cll(taacc,rmax)
579  call propagateerrflag_cll
580 
581  if (monitoring) then
582  pointscntaten_cll = pointscntaten_cll + 1
583 
584  if(maxval(taacc).gt.reqacc_cll) accpointscntaten_cll = accpointscntaten_cll + 1
585 
586  if(maxval(taacc).gt.critacc_cll) then
587  critpointscntaten_cll = critpointscntaten_cll + 1
588  if ( critpointscntaten_cll.le.noutcritpointsmax_cll(1) ) then
589  call critpointsout_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
590  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
591  write(ncpout_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
592  write(ncpout_cll,*)
593  endif
594 #ifdef CritPoints2
595  call critpointsout2_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
596  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
597  write(ncpout2_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
598  write(ncpout2_cll,*)
599  endif
600 #endif
601  end if
602  end if
603  end if
604 
605  end subroutine aten_args_cll
606 
607 
608 
609 
610 
611  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
612  ! subroutine Aten_cll(TA,TAuv,m02,rmax,TAerr)
613  !
614  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
615 
616  subroutine aten_args_list_cll(TA,TAuv,m02,rmax,TAerr)
617 
618  integer, intent(in) :: rmax
619  double complex,intent(in) :: m02
620  double complex, intent(out) :: TA(:),TAuv(:)
621  double precision, intent(out), optional :: TAerr(0:)
622  integer :: r,i
623  logical :: eflag
624 
625  if (1.gt.nmax_cll) then
626  call seterrflag_cll(-10)
627  call errout_cll('Aten_cll','Nmax_cll smaller 1',eflag,.true.)
628  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
629  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 1'
630  call propagateerrflag_cll
631  return
632  end if
633  if (rmax.gt.rmax_cll) then
634  call seterrflag_cll(-10)
635  call errout_cll('Aten_cll','argument rmax larger than rmax_cll',eflag,.true.)
636  write(nerrout_cll,*) 'rmax =',rmax
637  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
638  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
639  call propagateerrflag_cll
640  return
641  end if
642 
643  call aten_args_list_checked_cll(ta,tauv,m02,rmax,taerr)
644 
645  end subroutine aten_args_list_cll
646 
647 
648  subroutine aten_args_list_checked_cll(TA,TAuv,m02,rmax,TAerr)
649 
650  integer, intent(in) :: rmax
651  double complex,intent(in) :: m02
652  double complex, intent(out) :: TA(RtS(rmax)),TAuv(RtS(rmax))
653  double precision, intent(out), optional :: TAerr(0:rmax)
654  double complex :: TA2(RtS(rmax)),TAuv2(RtS(rmax))
655  double complex :: CA(0:rmax/2), CAuv(0:rmax/2)
656  double precision :: CAerr(0:rmax), TAerr_aux(0:rmax), TAerr_aux2(0:rmax)
657  double complex :: args(1),masses2(0:0)
658  double precision :: TAdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TAacc(0:rmax)
659  integer :: r,i
660  logical :: eflag
661 
662  args(1) = m02
663  masses2(0) = m02
664  call setmasterfname_cll('Aten_cll')
665  call setmastern_cll(1)
666  call setmasterr_cll(rmax)
667  call setmasterargs_cll(1,args)
668 
669  call settencache_cll(tenred_cll-1)
670 
671  if (mode_cll.eq.3) then
672  ! calculate tensor with coefficients from COLI
673  mode_cll = 1
674  call a_cll(ca,cauv,m02,rmax,caerr,0)
675  call calctensora_list(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
676 
677  ! calculate tensor with coefficients from DD
678  mode_cll = 2
679  call a_cll(ca,cauv,m02,rmax,caerr,0)
680  call calctensora_list(ta2,tauv2,taerr_aux2,ca,cauv,caerr,rmax)
681 
682  ! comparison --> take better result
683  mode_cll = 3
684  do r=0,rmax
685  norm_coli=0d0
686  norm_dd=0d0
687  do i=rts(r-1)+1,rts(r)
688  norm_coli = max(norm_coli,abs(ta(i)))
689  norm_dd = max(norm_dd,abs(ta2(i)))
690  end do
691  if (norm_coli.eq.0d0) then
692  norm_coli = abs(masses2(0))
693  if(norm_coli.ne.0d0) then
694  norm_coli=norm_coli**(1+real(r)/2)
695  else
696  norm_coli=muuv2_cll**(1+real(r)/2)
697  end if
698  end if
699  if (norm_dd.eq.0d0) then
700  norm_dd = abs(masses2(0))
701  if(norm_dd.ne.0d0) then
702  norm_dd=norm_dd**(1+real(r)/2)
703  else
704  norm_dd=muuv2_cll**(1+real(r)/2)
705  end if
706  end if
707  norm(r) = min(norm_coli,norm_dd)
708  end do
709 
710  call checktenalist_cll(ta,ta2,masses2,norm,rmax,tadiff)
711 
712  if (taerr_aux(rmax).lt.taerr_aux2(rmax)) then
713  if (present(taerr)) taerr = max(taerr_aux,tadiff*norm)
714  do r=0,rmax
715  taacc(r) = max(taerr_aux(r)/norm(r),tadiff(r))
716  end do
717  if (monitoring) pointscntaten_coli = pointscntaten_coli + 1
718  else
719  ta = ta2
720  tauv = tauv2
721  if (present(taerr)) taerr = max(taerr_aux2,tadiff*norm)
722  do r=0,rmax
723  taacc(r) = max(taerr_aux2(r)/norm(r),tadiff(r))
724  end do
725  if (monitoring) pointscntaten_dd = pointscntaten_dd + 1
726  end if
727 
728  else
729  call a_cll(ca,cauv,m02,rmax,caerr,0)
730  call calctensora_list(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
731  if (present(taerr)) taerr = taerr_aux
732  do r=0,rmax
733  norm(r)=0d0
734  do i=rts(r-1)+1,rts(r)
735  norm(r) = max(norm(r),abs(ta(i)))
736  end do
737  if (norm(r).eq.0d0) then
738  norm(r) = abs(masses2(0))
739  if(norm(r).ne.0d0) then
740  norm(r)=norm(r)**(1+real(r)/2)
741  else
742  norm(r)=muuv2_cll**(1+real(r)/2)
743  end if
744  end if
745  end do
746  do r=0,rmax
747  taacc(r) = taerr_aux(r)/norm(r)
748  end do
749 
750  end if
751 
752  call propagateaccflag_cll(taacc,rmax)
753  call propagateerrflag_cll
754 
755  if (monitoring) then
756  pointscntaten_cll = pointscntaten_cll + 1
757 
758  if(maxval(taacc).gt.reqacc_cll) accpointscntaten_cll = accpointscntaten_cll + 1
759 
760  if(maxval(taacc).gt.critacc_cll) then
761  critpointscntaten_cll = critpointscntaten_cll + 1
762  if ( critpointscntaten_cll.le.noutcritpointsmax_cll(1) ) then
763  call critpointsout_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
764  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
765  write(ncpout_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
766  write(ncpout_cll,*)
767  endif
768 #ifdef CritPoints2
769  call critpointsout2_cll('TAten_cll',0,maxval(taacc),critpointscntaten_cll)
770  if( critpointscntaten_cll.eq.noutcritpointsmax_cll(1)) then
771  write(ncpout2_cll,*) ' Further output of Critical Points for TAten_cll suppressed'
772  write(ncpout2_cll,*)
773  endif
774 #endif
775  end if
776  end if
777  end if
778 
779  end subroutine aten_args_list_checked_cll
780 
781 
782 
783 
784 
785  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
786  ! subroutine Bten_main_cll(TB.TBuv,mom,MomInv,masses2,rmax,TBerr)
787  !
788  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
789 
790  subroutine bten_main_cll(TB,TBuv,MomVec,MomInv,masses2,rmax,TBerr)
791 
792  integer, intent(in) :: rmax
793  double complex, intent(in) :: MomVec(0:3,1), MomInv(1), masses2(0:1)
794  double complex, intent(out) :: TB(0:rmax,0:rmax,0:rmax,0:rmax)
795  double complex, intent(out) :: TBuv(0:rmax,0:rmax,0:rmax,0:rmax)
796  double precision, intent(out), optional :: TBerr(0:rmax)
797  double complex :: TB2(0:rmax,0:rmax,0:rmax,0:rmax), TBuv2(0:rmax,0:rmax,0:rmax,0:rmax)
798  double complex :: CB(0:rmax/2,0:rmax), CBuv(0:rmax/2,0:rmax)
799  double precision :: CBerr(0:rmax), TBerr_aux(0:rmax), TBerr_aux2(0:rmax)
800  double complex :: args(7)
801  double precision :: TBdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TBacc(0:rmax)
802  integer :: r,n0,n1,n2,n3
803  logical :: eflag
804 
805  if (2.gt.nmax_cll) then
806  call seterrflag_cll(-10)
807  call errout_cll('Bten_cll','Nmax_cll smaller 2',eflag,.true.)
808  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
809  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 2'
810  call propagateerrflag_cll
811  return
812  end if
813  if (rmax.gt.rmax_cll) then
814  call seterrflag_cll(-10)
815  call errout_cll('Bten_cll','argument rmax larger than rmax_cll',eflag,.true.)
816  write(nerrout_cll,*) 'rmax =',rmax
817  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
818  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
819  call propagateerrflag_cll
820  return
821  end if
822 
823  ! set ID of master call
824  args(1:4) = momvec(0:,1)
825  args(5) = mominv(1)
826  args(6:7) = masses2(0:)
827  call setmasterfname_cll('Bten_cll')
828  call setmastern_cll(2)
829  call setmasterr_cll(rmax)
830  call setmasterargs_cll(7,args)
831 
832  call settencache_cll(tenred_cll-1)
833 
834  if (mode_cll.eq.3) then
835  ! calculate tensor with coefficients from COLI
836  mode_cll = 1
837  call b_main_cll(cb,cbuv,mominv(1),masses2(0),masses2(1),rmax,cberr,0)
838  call calctensorb(tb,tbuv,tberr_aux,cb,cbuv,cberr,momvec(0:,1),rmax)
839 
840  ! calculate tensor with coefficients from DD
841  mode_cll = 2
842  call b_main_cll(cb,cbuv,mominv(1),masses2(0),masses2(1),rmax,cberr,0)
843  call calctensorb(tb2,tbuv2,tberr_aux2,cb,cbuv,cberr,momvec(0:,1),rmax)
844 
845  ! comparison --> take better result
846  mode_cll = 3
847  do r=0,rmax
848  norm_coli=0d0
849  norm_dd=0d0
850  do n0=0,r
851  do n1=0,r-n0
852  do n2=0,r-n0-n1
853  n3=r-n0-n1-n2
854  norm_coli = max(norm_coli,abs(tb(n0,n1,n2,n3)))
855  norm_dd = max(norm_dd,abs(tb2(n0,n1,n2,n3)))
856  end do
857  end do
858  end do
859  if (norm_coli.eq.0d0) then
860  norm_coli = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
861  if(norm_coli.ne.0d0) then
862  norm_coli=norm_coli**(real(r)/2)
863  else
864  norm_coli=muir2_cll**(real(r)/2)
865  end if
866  end if
867  if (norm_dd.eq.0d0) then
868  norm_dd = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
869  if(norm_dd.ne.0d0) then
870  norm_dd=norm_dd**(real(r)/2)
871  else
872  norm_dd=muir2_cll**(real(r)/2)
873  end if
874  end if
875  norm(r) = min(norm_coli,norm_dd)
876  end do
877 
878  call checktensors_cll(tb,tb2,momvec,mominv,masses2,norm,2,rmax,tbdiff)
879 
880  if (tberr_aux(rmax).lt.tberr_aux2(rmax)) then
881  if (present(tberr)) tberr = max(tberr_aux,tbdiff*norm)
882  do r=0,rmax
883  tbacc(r) = max(tberr_aux(r)/norm(r),tbdiff(r))
884  end do
885  if (monitoring) pointscntbten_coli = pointscntbten_coli + 1
886  else
887  tb = tb2
888  tbuv = tbuv2
889  if (present(tberr)) tberr = max(tberr_aux2,tbdiff*norm)
890  do r=0,rmax
891  tbacc(r) = max(tberr_aux2(r)/norm(r),tbdiff(r))
892  end do
893  if (monitoring) pointscntbten_dd = pointscntbten_dd + 1
894  end if
895 
896  else
897  call b_main_cll(cb,cbuv,mominv(1),masses2(0),masses2(1),rmax,cberr,0)
898  call calctensorb(tb,tbuv,tberr_aux,cb,cbuv,cberr,momvec(0:,1),rmax)
899  if (present(tberr)) tberr = tberr_aux
900  norm = 0d0
901  do r=0,rmax
902  do n0=0,r
903  do n1=0,r-n0
904  do n2=0,r-n0-n1
905  n3=r-n0-n1-n2
906  norm(r) = max(norm(r),abs(tb(n0,n1,n2,n3)))
907  end do
908  end do
909  end do
910  if (norm(r).eq.0d0) then
911  norm(r) = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
912  if(norm(r).ne.0d0) then
913  norm(r)=norm(r)**(real(r)/2)
914  else
915  norm(r)=muir2_cll**(real(r)/2)
916  end if
917  end if
918  tbacc(r) = tberr_aux(r)/norm(r)
919  end do
920 
921  end if
922 
923  call propagateaccflag_cll(tbacc,rmax)
924  call propagateerrflag_cll
925 
926  if (monitoring) then
927  pointscntbten_cll = pointscntbten_cll + 1
928 
929  if(maxval(tbacc).gt.reqacc_cll) accpointscntbten_cll = accpointscntbten_cll + 1
930 
931  if(maxval(tbacc).gt.critacc_cll) then
932  critpointscntbten_cll = critpointscntbten_cll + 1
933  if ( critpointscntbten_cll.le.noutcritpointsmax_cll(2) ) then
934  call critpointsout_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
935  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
936  write(ncpout_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
937  write(ncpout_cll,*)
938  endif
939 #ifdef CritPoints2
940  call critpointsout2_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
941  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
942  write(ncpout2_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
943  write(ncpout2_cll,*)
944  endif
945 #endif
946  end if
947  end if
948  end if
949 
950  end subroutine bten_main_cll
951 
952 
953 
954 
955 
956  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
957  ! subroutine Bten_list_cll(TB.TBuv,mom,MomInv,masses2,rmax,TBerr)
958  !
959  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
960 
961  subroutine bten_list_cll(TB,TBuv,MomVec,MomInv,masses2,rmax,TBerr)
962 
963  integer, intent(in) :: rmax
964  double complex, intent(in) :: MomVec(0:3,1), MomInv(1), masses2(0:1)
965  double complex, intent(out) :: TB(:), TBuv(:)
966  double precision, intent(out), optional :: TBerr(0:rmax)
967  integer :: r,i
968  logical :: eflag
969 
970  if (2.gt.nmax_cll) then
971  call seterrflag_cll(-10)
972  call errout_cll('Bten_cll','Nmax_cll smaller 2',eflag,.true.)
973  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
974  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 2'
975  call propagateerrflag_cll
976  return
977  end if
978  if (rmax.gt.rmax_cll) then
979  call seterrflag_cll(-10)
980  call errout_cll('Bten_cll','argument rmax larger than rmax_cll',eflag,.true.)
981  write(nerrout_cll,*) 'rmax =',rmax
982  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
983  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
984  call propagateerrflag_cll
985  return
986  end if
987 
988  call bten_list_checked_cll(tb,tbuv,momvec,mominv,masses2,rmax,tberr)
989 
990  end subroutine bten_list_cll
991 
992 
993  subroutine bten_list_checked_cll(TB,TBuv,MomVec,MomInv,masses2,rmax,TBerr)
994 
995  integer, intent(in) :: rmax
996  double complex, intent(in) :: MomVec(0:3,1), MomInv(1), masses2(0:1)
997  double complex, intent(out) :: TB(RtS(rmax)), TBuv(RtS(rmax))
998  double precision, intent(out), optional :: TBerr(0:rmax)
999  double complex :: TB2(RtS(rmax)), TBuv2(RtS(rmax))
1000  double complex :: CB(0:rmax/2,0:rmax), CBuv(0:rmax/2,0:rmax)
1001  double precision :: CBerr(0:rmax), TBerr_aux(0:rmax), TBerr_aux2(0:rmax)
1002  double complex :: args(7)
1003  double precision :: TBdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TBacc(0:rmax)
1004  integer :: r,i
1005  logical :: eflag
1006 
1007  ! set ID of master call
1008  args(1:4) = momvec(0:,1)
1009  args(5) = mominv(1)
1010  args(6:7) = masses2(0:)
1011  call setmasterfname_cll('Bten_cll')
1012  call setmastern_cll(2)
1013  call setmasterr_cll(rmax)
1014  call setmasterargs_cll(7,args)
1015 
1016  call settencache_cll(tenred_cll-1)
1017 
1018  if (mode_cll.eq.3) then
1019  ! calculate tensor with coefficients from COLI
1020  mode_cll = 1
1021  call b_main_cll(cb,cbuv,mominv(1),masses2(0),masses2(1),rmax,cberr,0)
1022  call calctensorb_list(tb,tbuv,tberr_aux,cb,cbuv,cberr,momvec(0:,1),rmax)
1023 
1024  ! calculate tensor with coefficients from DD
1025  mode_cll = 2
1026  call b_main_cll(cb,cbuv,mominv(1),masses2(0),masses2(1),rmax,cberr,0)
1027  call calctensorb_list(tb2,tbuv2,tberr_aux2,cb,cbuv,cberr,momvec(0:,1),rmax)
1028 
1029  ! comparison --> take better result
1030  mode_cll = 3
1031  do r=0,rmax
1032  norm_coli=0d0
1033  norm_dd=0d0
1034  do i=rts(r-1)+1,rts(r)
1035  norm_coli = max(norm_coli,abs(tb(i)))
1036  norm_dd = max(norm_dd,abs(tb2(i)))
1037  end do
1038  if (norm_coli.eq.0d0) then
1039  norm_coli = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1040  if(norm_coli.ne.0d0) then
1041  norm_coli=norm_coli**(real(r)/2)
1042  else
1043  norm_coli=muir2_cll**(real(r)/2)
1044  end if
1045  end if
1046  if (norm_dd.eq.0d0) then
1047  norm_dd = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1048  if(norm_dd.ne.0d0) then
1049  norm_dd=norm_dd**(real(r)/2)
1050  else
1051  norm_dd=muir2_cll**(real(r)/2)
1052  end if
1053  end if
1054  norm(r) = min(norm_coli,norm_dd)
1055  end do
1056 
1057  call checktensorslist_cll(tb,tb2,momvec,mominv,masses2,norm,2,rmax,tbdiff)
1058 
1059  if (tberr_aux(rmax).lt.tberr_aux2(rmax)) then
1060  if (present(tberr)) tberr = max(tberr_aux,tbdiff*norm)
1061  do r=0,rmax
1062  tbacc(r) = max(tberr_aux(r)/norm(r),tbdiff(r))
1063  end do
1064  if (monitoring) pointscntbten_coli = pointscntbten_coli + 1
1065  else
1066  tb = tb2
1067  tbuv = tbuv2
1068  if (present(tberr)) tberr = max(tberr_aux2,tbdiff*norm)
1069  do r=0,rmax
1070  tbacc(r) = max(tberr_aux2(r)/norm(r),tbdiff(r))
1071  end do
1072  if (monitoring) pointscntbten_dd = pointscntbten_dd + 1
1073  end if
1074 
1075  else
1076  call b_main_cll(cb,cbuv,mominv(1),masses2(0),masses2(1),rmax,cberr,0)
1077  call calctensorb_list(tb,tbuv,tberr_aux,cb,cbuv,cberr,momvec(0:,1),rmax)
1078  if (present(tberr)) tberr = tberr_aux
1079  norm = 0d0
1080  do r=0,rmax
1081  do i=rts(r-1)+1,rts(r)
1082  norm(r) = max(norm(r),abs(tb(i)))
1083  end do
1084  if (norm(r).eq.0d0) then
1085  norm(r) = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1086  if(norm(r).ne.0d0) then
1087  norm(r)=norm(r)**(real(r)/2)
1088  else
1089  norm(r)=muir2_cll**(real(r)/2)
1090  end if
1091  end if
1092  tbacc(r) = tberr_aux(r)/norm(r)
1093  end do
1094 
1095  end if
1096 
1097  call propagateaccflag_cll(tbacc,rmax)
1098  call propagateerrflag_cll
1099 
1100  if (monitoring) then
1101  pointscntbten_cll = pointscntbten_cll + 1
1102 
1103  if(maxval(tbacc).gt.reqacc_cll) accpointscntbten_cll = accpointscntbten_cll + 1
1104 
1105  if(maxval(tbacc).gt.critacc_cll) then
1106  critpointscntbten_cll = critpointscntbten_cll + 1
1107  if ( critpointscntbten_cll.le.noutcritpointsmax_cll(2) ) then
1108  call critpointsout_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
1109  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
1110  write(ncpout_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
1111  write(ncpout_cll,*)
1112  endif
1113 #ifdef CritPoints2
1114  call critpointsout2_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
1115  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
1116  write(ncpout2_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
1117  write(ncpout2_cll,*)
1118  endif
1119 #endif
1120  end if
1121  end if
1122  end if
1123 
1124  end subroutine bten_list_checked_cll
1125 
1126 
1127 
1128 
1129 
1130  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1131  ! subroutine Bten_args_cll(TB,TBuv,p1vec,p10,m02,m12,rmax,TBerr)
1132  !
1133  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1134 
1135  subroutine bten_args_cll(TB,TBuv,p1vec,p10,m02,m12,rmax,TBerr)
1136 
1137  integer, intent(in) :: rmax
1138  double complex, intent(in) :: p1vec(0:3)
1139  double complex, intent(in) :: p10,m02,m12
1140  double complex, intent(out) :: TB(0:rmax,0:rmax,0:rmax,0:rmax)
1141  double complex, intent(out) :: TBuv(0:rmax,0:rmax,0:rmax,0:rmax)
1142  double precision, intent(out), optional :: TBerr(0:rmax)
1143  double complex :: TB2(0:rmax,0:rmax,0:rmax,0:rmax), TBuv2(0:rmax,0:rmax,0:rmax,0:rmax)
1144  double complex :: masses2(0:1),MomInv(1)
1145  double complex :: CB(0:rmax/2,0:rmax), CBuv(0:rmax/2,0:rmax)
1146  double precision :: CBerr(0:rmax),TBerr_aux(0:rmax),TBerr_aux2(0:rmax)
1147  double complex :: args(7)
1148  double precision :: TBdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TBacc(0:rmax)
1149  integer :: r,n0,n1,n2,n3
1150  logical :: eflag
1151 
1152  if (2.gt.nmax_cll) then
1153  call seterrflag_cll(-10)
1154  call errout_cll('Bten_cll','Nmax_cll smaller 2',eflag,.true.)
1155  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1156  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 2'
1157  call propagateerrflag_cll
1158  return
1159  end if
1160  if (rmax.gt.rmax_cll) then
1161  call seterrflag_cll(-10)
1162  call errout_cll('Bten_cll','argument rmax larger than rmax_cll',eflag,.true.)
1163  write(nerrout_cll,*) 'rmax =',rmax
1164  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1165  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1166  call propagateerrflag_cll
1167  return
1168  end if
1169 
1170  masses2(0) = m02
1171  masses2(1) = m12
1172  mominv(1) = p10
1173 
1174  ! set ID of master call
1175  args(1:4) = p1vec(0:)
1176  args(5) = p10
1177  args(6:7) = masses2(0:)
1178  call setmasterfname_cll('Bten_cll')
1179  call setmastern_cll(2)
1180  call setmasterr_cll(rmax)
1181  call setmasterargs_cll(7,args)
1182 
1183  call settencache_cll(tenred_cll-1)
1184 
1185  if (mode_cll.eq.3) then
1186  ! calculate tensor with coefficients from COLI
1187  mode_cll = 1
1188  call b_main_cll(cb,cbuv,p10,m02,m12,rmax,cberr,0)
1189  call calctensorb(tb,tbuv,tberr_aux,cb,cbuv,cberr,p1vec,rmax)
1190 
1191  ! calculate tensor with coefficients from DD
1192  mode_cll = 2
1193  call b_main_cll(cb,cbuv,p10,m02,m12,rmax,cberr,0)
1194  call calctensorb(tb2,tbuv2,tberr_aux2,cb,cbuv,cberr,p1vec,rmax)
1195 
1196  ! comparison --> take better result
1197  mode_cll = 3
1198  do r=0,rmax
1199  norm_coli=0d0
1200  norm_dd=0d0
1201  do n0=0,r
1202  do n1=0,r-n0
1203  do n2=0,r-n0-n1
1204  n3=r-n0-n1-n2
1205  norm_coli = max(norm_coli,abs(tb(n0,n1,n2,n3)))
1206  norm_dd = max(norm_dd,abs(tb2(n0,n1,n2,n3)))
1207  end do
1208  end do
1209  end do
1210  if (norm_coli.eq.0d0) then
1211  norm_coli = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1212  if(norm_coli.ne.0d0) then
1213  norm_coli=norm_coli**(real(r)/2)
1214  else
1215  norm_coli=muir2_cll**(real(r)/2)
1216  end if
1217  end if
1218  if (norm_dd.eq.0d0) then
1219  norm_dd = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1220  if(norm_dd.ne.0d0) then
1221  norm_dd=norm_dd**(real(r)/2)
1222  else
1223  norm_dd=muir2_cll**(real(r)/2)
1224  end if
1225  end if
1226  norm(r) = min(norm_coli,norm_dd)
1227  end do
1228 
1229  call checktensors_cll(tb,tb2,p1vec,mominv,masses2,norm,2,rmax,tbdiff)
1230 
1231  if (tberr_aux(rmax).lt.tberr_aux2(rmax)) then
1232  if (present(tberr)) tberr = max(tberr_aux,tbdiff*norm)
1233  do r=0,rmax
1234  tbacc(r) = max(tberr_aux(r)/norm(r),tbdiff(r))
1235  end do
1236  if (monitoring) pointscntbten_coli = pointscntbten_coli + 1
1237  else
1238  tb = tb2
1239  tbuv = tbuv2
1240  if (present(tberr)) tberr = max(tberr_aux2,tbdiff*norm)
1241  do r=0,rmax
1242  tbacc(r) = max(tberr_aux2(r)/norm(r),tbdiff(r))
1243  end do
1244  if (monitoring) pointscntbten_dd = pointscntbten_dd + 1
1245  end if
1246 
1247  else
1248  call b_main_cll(cb,cbuv,p10,m02,m12,rmax,cberr,0)
1249  call calctensorb(tb,tbuv,tberr_aux,cb,cbuv,cberr,p1vec,rmax)
1250  if (present(tberr)) tberr = tberr_aux
1251  norm = 0d0
1252  do r=0,rmax
1253  do n0=0,r
1254  do n1=0,r-n0
1255  do n2=0,r-n0-n1
1256  n3=r-n0-n1-n2
1257  norm(r) = max(norm(r),abs(tb(n0,n1,n2,n3)))
1258  end do
1259  end do
1260  end do
1261  if (norm(r).eq.0d0) then
1262  norm(r) = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1263  if(norm(r).ne.0d0) then
1264  norm(r)=norm(r)**(real(r)/2)
1265  else
1266  norm(r)=muir2_cll**(real(r)/2)
1267  end if
1268  end if
1269  tbacc(r) = tberr_aux(r)/norm(r)
1270  end do
1271 
1272  end if
1273 
1274  call propagateaccflag_cll(tbacc,rmax)
1275  call propagateerrflag_cll
1276 
1277  if (monitoring) then
1278  pointscntbten_cll = pointscntbten_cll + 1
1279 
1280  if(maxval(tbacc).gt.reqacc_cll) accpointscntbten_cll = accpointscntbten_cll + 1
1281 
1282  if(maxval(tbacc).gt.critacc_cll) then
1283  critpointscntbten_cll = critpointscntbten_cll + 1
1284  if ( critpointscntbten_cll.le.noutcritpointsmax_cll(2) ) then
1285  call critpointsout_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
1286  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
1287  write(ncpout_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
1288  write(ncpout_cll,*)
1289  endif
1290 #ifdef CritPoints2
1291  call critpointsout2_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
1292  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
1293  write(ncpout2_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
1294  write(ncpout2_cll,*)
1295  endif
1296 #endif
1297  end if
1298  end if
1299  end if
1300 
1301  end subroutine bten_args_cll
1302 
1303 
1304 
1305 
1306 
1307  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1308  ! subroutine Bten_args_list_cll(TB,TBuv,p1vec,p10,m02,m12,rmax,TBerr)
1309  !
1310  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1311 
1312  subroutine bten_args_list_cll(TB,TBuv,p1vec,p10,m02,m12,rmax,TBerr)
1313 
1314  integer, intent(in) :: rmax
1315  double complex, intent(in) :: p1vec(0:3)
1316  double complex, intent(in) :: p10,m02,m12
1317  double complex, intent(out) :: TB(:), TBuv(:)
1318  double precision, intent(out), optional :: TBerr(0:rmax)
1319  integer :: r,i
1320  logical :: eflag
1321 
1322  if (2.gt.nmax_cll) then
1323  call seterrflag_cll(-10)
1324  call errout_cll('Bten_cll','Nmax_cll smaller 2',eflag,.true.)
1325  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1326  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 2'
1327  call propagateerrflag_cll
1328  return
1329  end if
1330  if (rmax.gt.rmax_cll) then
1331  call seterrflag_cll(-10)
1332  call errout_cll('Bten_cll','argument rmax larger than rmax_cll',eflag,.true.)
1333  write(nerrout_cll,*) 'rmax =',rmax
1334  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1335  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1336  call propagateerrflag_cll
1337  return
1338  end if
1339 
1340  call bten_args_list_checked_cll(tb,tbuv,p1vec,p10,m02,m12,rmax,tberr)
1341 
1342  end subroutine bten_args_list_cll
1343 
1344 
1345  subroutine bten_args_list_checked_cll(TB,TBuv,p1vec,p10,m02,m12,rmax,TBerr)
1346 
1347  integer, intent(in) :: rmax
1348  double complex, intent(in) :: p1vec(0:3)
1349  double complex, intent(in) :: p10,m02,m12
1350  double complex, intent(out) :: TB(RtS(rmax)), TBuv(RtS(rmax))
1351  double precision, intent(out), optional :: TBerr(0:rmax)
1352  double complex :: TB2(RtS(rmax)), TBuv2(RtS(rmax))
1353  double complex :: masses2(0:1),MomInv(1)
1354  double complex :: CB(0:rmax/2,0:rmax), CBuv(0:rmax/2,0:rmax)
1355  double precision :: CBerr(0:rmax), TBerr_aux(0:rmax), TBerr_aux2(0:rmax)
1356  double complex :: args(7)
1357  double precision :: TBdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TBacc(0:rmax)
1358  integer :: r,i
1359  logical :: eflag
1360 
1361  masses2(0) = m02
1362  masses2(1) = m12
1363  mominv(1) = p10
1364 
1365  ! set ID of master call
1366  args(1:4) = p1vec(0:)
1367  args(5) = p10
1368  args(6:7) = masses2(0:)
1369  call setmasterfname_cll('Bten_cll')
1370  call setmastern_cll(2)
1371  call setmasterr_cll(rmax)
1372  call setmasterargs_cll(7,args)
1373 
1374  call settencache_cll(tenred_cll-1)
1375 
1376  if (mode_cll.eq.3) then
1377  ! calculate tensor with coefficients from COLI
1378  mode_cll = 1
1379  call b_main_cll(cb,cbuv,p10,m02,m12,rmax,cberr,0)
1380  call calctensorb_list(tb,tbuv,tberr_aux,cb,cbuv,cberr,p1vec,rmax)
1381 
1382  ! calculate tensor with coefficients from DD
1383  mode_cll = 2
1384  call b_main_cll(cb,cbuv,p10,m02,m12,rmax,cberr,0)
1385  call calctensorb_list(tb2,tbuv2,tberr_aux2,cb,cbuv,cberr,p1vec,rmax)
1386 
1387  ! comparison --> take better result
1388  mode_cll = 3
1389  do r=0,rmax
1390  norm_coli=0d0
1391  norm_dd=0d0
1392  do i=rts(r-1)+1,rts(r)
1393  norm_coli = max(norm_coli,abs(tb(i)))
1394  norm_dd = max(norm_dd,abs(tb2(i)))
1395  end do
1396  if (norm_coli.eq.0d0) then
1397  norm_coli = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1398  if(norm_coli.ne.0d0) then
1399  norm_coli=norm_coli**(real(r)/2)
1400  else
1401  norm_coli=muir2_cll**(real(r)/2)
1402  end if
1403  end if
1404  if (norm_dd.eq.0d0) then
1405  norm_dd = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1406  if(norm_dd.ne.0d0) then
1407  norm_dd=norm_dd**(real(r)/2)
1408  else
1409  norm_dd=muir2_cll**(real(r)/2)
1410  end if
1411  end if
1412  norm(r) = min(norm_coli,norm_dd)
1413  end do
1414 
1415  call checktensorslist_cll(tb,tb2,p1vec,mominv,masses2,norm,2,rmax,tbdiff)
1416 
1417  if (tberr_aux(rmax).lt.tberr_aux2(rmax)) then
1418  if (present(tberr)) tberr = max(tberr_aux,tbdiff*norm)
1419  do r=0,rmax
1420  tbacc(r) = max(tberr_aux(r)/norm(r),tbdiff(r))
1421  end do
1422  if (monitoring) pointscntbten_coli = pointscntbten_coli + 1
1423  else
1424  tb = tb2
1425  tbuv = tbuv2
1426  if (present(tberr)) tberr = max(tberr_aux2,tbdiff*norm)
1427  do r=0,rmax
1428  tbacc(r) = max(tberr_aux2(r)/norm(r),tbdiff(r))
1429  end do
1430  if (monitoring) pointscntbten_dd = pointscntbten_dd + 1
1431  end if
1432 
1433  else
1434  call b_main_cll(cb,cbuv,p10,m02,m12,rmax,cberr,0)
1435  call calctensorb_list(tb,tbuv,tberr_aux,cb,cbuv,cberr,p1vec,rmax)
1436  if (present(tberr)) tberr = tberr_aux
1437  norm = 0d0
1438  do r=0,rmax
1439  do i=rts(r-1)+1,rts(r)
1440  norm(r) = max(norm(r),abs(tb(i)))
1441  end do
1442  if (norm(r).eq.0d0) then
1443  norm(r) = max(abs(mominv(1)),maxval(abs(masses2(0:1))))
1444  if(norm(r).ne.0d0) then
1445  norm(r)=norm(r)**(real(r)/2)
1446  else
1447  norm(r)=muir2_cll**(real(r)/2)
1448  end if
1449  end if
1450  tbacc(r) = tberr_aux(r)/norm(r)
1451  end do
1452 
1453  end if
1454 
1455  call propagateaccflag_cll(tbacc,rmax)
1456  call propagateerrflag_cll
1457 
1458  if (monitoring) then
1459  pointscntbten_cll = pointscntbten_cll + 1
1460 
1461  if(maxval(tbacc).gt.reqacc_cll) accpointscntbten_cll = accpointscntbten_cll + 1
1462 
1463  if(maxval(tbacc).gt.critacc_cll) then
1464  critpointscntbten_cll = critpointscntbten_cll + 1
1465  if ( critpointscntbten_cll.le.noutcritpointsmax_cll(2) ) then
1466  call critpointsout_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
1467  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
1468  write(ncpout_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
1469  write(ncpout_cll,*)
1470  endif
1471 #ifdef CritPoints2
1472  call critpointsout2_cll('TBten_cll',0,maxval(tbacc),critpointscntbten_cll)
1473  if( critpointscntbten_cll.eq.noutcritpointsmax_cll(2)) then
1474  write(ncpout2_cll,*) ' Further output of Critical Points for TBten_cll suppressed'
1475  write(ncpout2_cll,*)
1476  endif
1477 #endif
1478  end if
1479  end if
1480  end if
1481 
1482  end subroutine bten_args_list_checked_cll
1483 
1484 
1485 
1486 
1487 
1488  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1489  ! subroutine Cten_main_cll(TC,TCuv,MomVec,MomInv,masses2,rmax,TCerr)
1490  !
1491  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1492 
1493  subroutine cten_main_cll(TC,TCuv,MomVec,MomInv,masses2,rmax,TCerr)
1494 
1495  integer, intent(in) :: rmax
1496  double complex, intent(in) :: MomVec(0:3,2), MomInv(3), masses2(0:2)
1497  double complex, intent(out) :: TC(0:rmax,0:rmax,0:rmax,0:rmax)
1498  double complex, intent(out) :: TCuv(0:rmax,0:rmax,0:rmax,0:rmax)
1499  double precision, intent(out), optional :: TCerr(0:rmax)
1500  double complex :: TC2(0:rmax,0:rmax,0:rmax,0:rmax), TCuv2(0:rmax,0:rmax,0:rmax,0:rmax)
1501  double complex :: CC(0:rmax/2,0:rmax,0:rmax), CCuv(0:rmax/2,0:rmax,0:rmax)
1502  double precision :: CCerr(0:rmax), TCerr_aux(0:rmax), TCerr_aux2(0:rmax), TCacc(0:rmax)
1503  double complex args(14)
1504  double precision :: TCdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd
1505  integer :: r,n0,n1,n2,n3
1506  logical :: eflag
1507 
1508  if (3.gt.nmax_cll) then
1509  call seterrflag_cll(-10)
1510  call errout_cll('Cten_cll','Nmax_cll smaller 3',eflag,.true.)
1511  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1512  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 3'
1513  call propagateerrflag_cll
1514  return
1515  end if
1516  if (rmax.gt.rmax_cll) then
1517  call seterrflag_cll(-10)
1518  call errout_cll('Cten_cll','argument rmax larger than rmax_cll',eflag,.true.)
1519  write(nerrout_cll,*) 'rmax =',rmax
1520  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1521  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1522  call propagateerrflag_cll
1523  return
1524  end if
1525 
1526  ! set ID of master call
1527  args(1:4) = momvec(0:,1)
1528  args(5:8) = momvec(0:,2)
1529  args(9:11) = mominv
1530  args(12:14) = masses2(0:)
1531  call setmasterfname_cll('Cten_cll')
1532  call setmastern_cll(3)
1533  call setmasterr_cll(rmax)
1534  call setmasterargs_cll(14,args)
1535 
1536  call settencache_cll(tenred_cll-1)
1537 
1538  if (mode_cll.eq.3) then
1539  ! calculate tensor with coefficients from COLI
1540  mode_cll = 1
1541  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1542  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1543  call calctensorc(tc,tcuv,tcerr_aux,cc,ccuv,ccerr,momvec,rmax)
1544 
1545  ! calculate tensor with coefficients from DD
1546  mode_cll = 2
1547  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1548  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1549  call calctensorc(tc2,tcuv2,tcerr_aux2,cc,ccuv,ccerr,momvec,rmax)
1550 
1551  ! comparison --> take better result
1552  mode_cll = 3
1553  do r=0,rmax
1554  norm_coli=0d0
1555  norm_dd=0d0
1556  do n0=0,r
1557  do n1=0,r-n0
1558  do n2=0,r-n0-n1
1559  n3=r-n0-n1-n2
1560  norm_coli = max(norm_coli,abs(tc(n0,n1,n2,n3)))
1561  norm_dd = max(norm_dd,abs(tc2(n0,n1,n2,n3)))
1562  end do
1563  end do
1564  end do
1565  if (norm_coli.eq.0d0) then
1566  norm_coli = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1567  if(norm_coli.ne.0d0) then
1568  norm_coli=1d0/norm_coli**(1-real(r)/2)
1569  else
1570  norm_coli=1d0/muir2_cll**(1-real(r)/2)
1571  end if
1572  end if
1573  if (norm_dd.eq.0d0) then
1574  norm_dd = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1575  if(norm_dd.ne.0d0) then
1576  norm_dd=1d0/norm_dd**(1-real(r)/2)
1577  else
1578  norm_dd=1d0/muir2_cll**(1-real(r)/2)
1579  end if
1580  end if
1581  norm(r) = min(norm_coli,norm_dd)
1582  end do
1583 
1584  call checktensors_cll(tc,tc2,momvec,mominv,masses2,norm,3,rmax,tcdiff)
1585 
1586  if (tcerr_aux(rmax).lt.tcerr_aux2(rmax)) then
1587  if (present(tcerr)) tcerr = max(tcerr_aux,tcdiff*norm)
1588  do r=0,rmax
1589  tcacc(r) = max(tcerr_aux(r)/norm(r),tcdiff(r))
1590  end do
1591  if (monitoring) pointscntcten_coli = pointscntcten_coli + 1
1592  else
1593  tc = tc2
1594  tcuv = tcuv2
1595  if (present(tcerr)) tcerr = max(tcerr_aux2,tcdiff*norm)
1596  do r=0,rmax
1597  tcacc(r) = max(tcerr_aux2(r)/norm(r),tcdiff(r))
1598  end do
1599  if (monitoring) pointscntcten_dd = pointscntcten_dd + 1
1600  end if
1601 
1602  else
1603  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1604  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1605  call calctensorc(tc,tcuv,tcerr_aux,cc,ccuv,ccerr,momvec,rmax)
1606  if (present(tcerr)) tcerr = tcerr_aux
1607  norm=0d0
1608  do r=0,rmax
1609  do n0=0,r
1610  do n1=0,r-n0
1611  do n2=0,r-n0-n1
1612  n3=r-n0-n1-n2
1613  norm(r) = max(norm(r),abs(tc(n0,n1,n2,n3)))
1614  end do
1615  end do
1616  end do
1617  if (norm(r).eq.0d0) then
1618  norm(r) = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1619  if(norm(r).ne.0d0) then
1620  norm(r)=1d0/norm(r)**(1-real(r)/2)
1621  else
1622  norm(r)=1d0/muir2_cll**(1-real(r)/2)
1623  end if
1624  end if
1625  tcacc(r) = tcerr_aux(r)/norm(r)
1626  end do
1627 
1628  end if
1629 
1630  call propagateaccflag_cll(tcacc,rmax)
1631  call propagateerrflag_cll
1632 
1633  if (monitoring) then
1634  pointscntcten_cll = pointscntcten_cll + 1
1635 
1636  if(maxval(tcacc).gt.reqacc_cll) accpointscntcten_cll = accpointscntcten_cll + 1
1637 
1638  if(maxval(tcacc).gt.critacc_cll) then
1639  critpointscntcten_cll = critpointscntcten_cll + 1
1640  if ( critpointscntcten_cll.le.noutcritpointsmax_cll(3) ) then
1641  call critpointsout_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
1642  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
1643  write(ncpout_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
1644  write(ncpout_cll,*)
1645  endif
1646 #ifdef CritPoints2
1647  call critpointsout2_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
1648  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
1649  write(ncpout2_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
1650  write(ncpout2_cll,*)
1651  endif
1652 #endif
1653  end if
1654  end if
1655  end if
1656 
1657  end subroutine cten_main_cll
1658 
1659 
1660 
1661 
1662 
1663  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1664  ! subroutine Cten_list_cll(TC,TCuv,MomVec,MomInv,masses2,rmax,TCerr)
1665  !
1666  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1667 
1668  subroutine cten_list_cll(TC,TCuv,MomVec,MomInv,masses2,rmax,TCerr)
1669 
1670  integer, intent(in) :: rmax
1671  double complex, intent(in) :: MomVec(0:3,2), MomInv(3), masses2(0:2)
1672  double complex, intent(out) :: TC(:), TCuv(:)
1673  double precision, intent(out), optional :: TCerr(0:rmax)
1674  logical :: eflag
1675 
1676  if (3.gt.nmax_cll) then
1677  call seterrflag_cll(-10)
1678  call errout_cll('Cten_cll','Nmax_cll smaller 3',eflag,.true.)
1679  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1680  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 3'
1681  call propagateerrflag_cll
1682  return
1683  end if
1684  if (rmax.gt.rmax_cll) then
1685  call seterrflag_cll(-10)
1686  call errout_cll('Cten_cll','argument rmax larger than rmax_cll',eflag,.true.)
1687  write(nerrout_cll,*) 'rmax =',rmax
1688  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1689  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1690  call propagateerrflag_cll
1691  return
1692  end if
1693 
1694  call cten_list_checked_cll(tc,tcuv,momvec,mominv,masses2,rmax,tcerr)
1695 
1696  end subroutine cten_list_cll
1697 
1698 
1699  subroutine cten_list_checked_cll(TC,TCuv,MomVec,MomInv,masses2,rmax,TCerr)
1700 
1701  integer, intent(in) :: rmax
1702  double complex, intent(in) :: MomVec(0:3,2), MomInv(3), masses2(0:2)
1703  double complex, intent(out) :: TC(RtS(rmax)), TCuv(RtS(rmax))
1704  double precision, intent(out), optional :: TCerr(0:rmax)
1705  double complex :: TC2(RtS(rmax)), TCuv2(RtS(rmax))
1706  double complex :: CC(0:rmax/2,0:rmax,0:rmax), CCuv(0:rmax/2,0:rmax,0:rmax)
1707  double precision :: CCerr(0:rmax), TCerr_aux(0:rmax), TCerr_aux2(0:rmax)
1708  double complex :: args(14)
1709  double precision :: TCdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TCacc(0:rmax)
1710  integer :: r,i
1711  logical :: eflag
1712 
1713  ! set ID of master call
1714  args(1:4) = momvec(0:,1)
1715  args(5:8) = momvec(0:,2)
1716  args(9:11) = mominv
1717  args(12:14) = masses2(0:)
1718  call setmasterfname_cll('Cten_cll')
1719  call setmastern_cll(3)
1720  call setmasterr_cll(rmax)
1721  call setmasterargs_cll(14,args)
1722 
1723  call settencache_cll(tenred_cll-1)
1724 
1725  if (mode_cll.eq.3) then
1726  ! calculate tensor with coefficients from COLI
1727  mode_cll = 1
1728  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1729  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1730  call calctensorc_list(tc,tcuv,tcerr_aux,cc,ccuv,ccerr,momvec,rmax)
1731 
1732  ! calculate tensor with coefficients from DD
1733  mode_cll = 2
1734  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1735  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1736  call calctensorc_list(tc2,tcuv2,tcerr_aux2,cc,ccuv,ccerr,momvec,rmax)
1737 
1738  ! comparison --> take better result
1739  mode_cll = 3
1740  do r=0,rmax
1741  norm_coli=0d0
1742  norm_dd=0d0
1743  do i=rts(r-1)+1,rts(r)
1744  norm_coli = max(norm_coli,abs(tc(i)))
1745  norm_dd = max(norm_dd,abs(tc2(i)))
1746  end do
1747  if (norm_coli.eq.0d0) then
1748  norm_coli = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1749  if(norm_coli.ne.0d0) then
1750  norm_coli=1d0/norm_coli**(1-real(r)/2)
1751  else
1752  norm_coli=1d0/muir2_cll**(1-real(r)/2)
1753  end if
1754  end if
1755  if (norm_dd.eq.0d0) then
1756  norm_dd = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1757  if(norm_dd.ne.0d0) then
1758  norm_dd=1d0/norm_dd**(1-real(r)/2)
1759  else
1760  norm_dd=1d0/muir2_cll**(1-real(r)/2)
1761  end if
1762  end if
1763  norm(r) = min(norm_coli,norm_dd)
1764  end do
1765 
1766  call checktensorslist_cll(tc,tc2,momvec,mominv,masses2,norm,3,rmax,tcdiff)
1767 
1768  if (tcerr_aux(rmax).lt.tcerr_aux2(rmax)) then
1769  if (present(tcerr)) tcerr = max(tcerr_aux,tcdiff*norm)
1770  do r=0,rmax
1771  tcacc(r) = max(tcerr_aux(r)/norm(r),tcdiff(r))
1772  end do
1773  if (monitoring) pointscntcten_coli = pointscntcten_coli + 1
1774  else
1775  tc = tc2
1776  tcuv = tcuv2
1777  if (present(tcerr)) tcerr = max(tcerr_aux2,tcdiff*norm)
1778  do r=0,rmax
1779  tcacc(r) = max(tcerr_aux2(r)/norm(r),tcdiff(r))
1780  end do
1781  if (monitoring) pointscntcten_dd = pointscntcten_dd + 1
1782  end if
1783 
1784  else
1785  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1786  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1787  call calctensorc_list(tc,tcuv,tcerr_aux,cc,ccuv,ccerr,momvec,rmax)
1788  if (present(tcerr)) tcerr = tcerr_aux
1789  norm=0d0
1790  do r=0,rmax
1791  do i=rts(r-1)+1,rts(r)
1792  norm(r) = max(norm(r),abs(tc(i)))
1793  end do
1794  if (norm(r).eq.0d0) then
1795  norm(r) = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1796  if(norm(r).ne.0d0) then
1797  norm(r)=1d0/norm(r)**(1-real(r)/2)
1798  else
1799  norm(r)=1d0/muir2_cll**(1-real(r)/2)
1800  end if
1801  end if
1802  tcacc(r) = tcerr_aux(r)/norm(r)
1803  end do
1804 
1805  end if
1806 
1807  call propagateaccflag_cll(tcacc,rmax)
1808  call propagateerrflag_cll
1809 
1810  if (monitoring) then
1811  pointscntcten_cll = pointscntcten_cll + 1
1812 
1813  if(maxval(tcacc).gt.reqacc_cll) accpointscntcten_cll = accpointscntcten_cll + 1
1814 
1815  if(maxval(tcacc).gt.critacc_cll) then
1816  critpointscntcten_cll = critpointscntcten_cll + 1
1817  if ( critpointscntcten_cll.le.noutcritpointsmax_cll(3) ) then
1818  call critpointsout_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
1819  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
1820  write(ncpout_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
1821  write(ncpout_cll,*)
1822  endif
1823 #ifdef CritPoints2
1824  call critpointsout2_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
1825  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
1826  write(ncpout2_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
1827  write(ncpout2_cll,*)
1828  endif
1829 #endif
1830  end if
1831  end if
1832  end if
1833 
1834  end subroutine cten_list_checked_cll
1835 
1836 
1837 
1838 
1839 
1840  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1841  ! subroutine Cten_args_cll(TC,TCuv,p1vec,p2vec,p10,p21,p20,m02,m12,m22,rmax,TCerr)
1842  !
1843  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1844 
1845  subroutine cten_args_cll(TC,TCuv,p1vec,p2vec,p10,p21,p20,m02,m12,m22,rmax,TCerr)
1846 
1847  integer, intent(in) :: rmax
1848  double complex, intent(in) :: p1vec(0:3), p2vec(0:3)
1849  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
1850  double complex, intent(out) :: TC(0:rmax,0:rmax,0:rmax,0:rmax)
1851  double complex, intent(out) :: TCuv(0:rmax,0:rmax,0:rmax,0:rmax)
1852  double precision, intent(out), optional :: TCerr(0:rmax)
1853  double complex :: TC2(0:rmax,0:rmax,0:rmax,0:rmax), TCuv2(0:rmax,0:rmax,0:rmax,0:rmax)
1854  double complex :: MomVec(0:3,2), MomInv(3), masses2(0:2)
1855  double complex :: CC(0:rmax/2,0:rmax,0:rmax), CCuv(0:rmax/2,0:rmax,0:rmax)
1856  double precision :: CCerr(0:rmax), TCerr_aux(0:rmax), TCerr_aux2(0:rmax)
1857  double complex :: args(14)
1858  double precision :: TCdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TCacc(0:rmax)
1859  integer :: r,n0,n1,n2,n3
1860  logical :: eflag
1861 
1862  if (3.gt.nmax_cll) then
1863  call seterrflag_cll(-10)
1864  call errout_cll('Cten_cll','Nmax_cll smaller 3',eflag,.true.)
1865  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
1866  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 3'
1867  call propagateerrflag_cll
1868  return
1869  end if
1870  if (rmax.gt.rmax_cll) then
1871  call seterrflag_cll(-10)
1872  call errout_cll('Cten_cll','argument rmax larger than rmax_cll',eflag,.true.)
1873  write(nerrout_cll,*) 'rmax =',rmax
1874  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
1875  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
1876  call propagateerrflag_cll
1877  return
1878  end if
1879 
1880  momvec(0:,1) = p1vec
1881  momvec(0:,2) = p2vec
1882  mominv(1) = p10
1883  mominv(2) = p21
1884  mominv(3) = p20
1885  masses2(0) = m02
1886  masses2(1) = m12
1887  masses2(2) = m22
1888 
1889  ! set ID of master call
1890  args(1:4) = momvec(0:,1)
1891  args(5:8) = momvec(0:,2)
1892  args(9:11) = mominv
1893  args(12:14) = masses2(0:)
1894  call setmasterfname_cll('Cten_cll')
1895  call setmastern_cll(3)
1896  call setmasterr_cll(rmax)
1897  call setmasterargs_cll(14,args)
1898 
1899  call settencache_cll(tenred_cll-1)
1900 
1901 
1902  if (mode_cll.eq.3) then
1903  ! calculate tensor with coefficients from COLI
1904  mode_cll = 1
1905  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1906  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1907  call calctensorc(tc,tcuv,tcerr_aux,cc,ccuv,ccerr,momvec,rmax)
1908 
1909  ! calculate tensor with coefficients from DD
1910  mode_cll = 2
1911  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1912  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1913  call calctensorc(tc2,tcuv2,tcerr_aux2,cc,ccuv,ccerr,momvec,rmax)
1914 
1915  ! comparison --> take better result
1916  mode_cll = 3
1917  do r=0,rmax
1918  norm_coli=0d0
1919  norm_dd=0d0
1920  do n0=0,r
1921  do n1=0,r-n0
1922  do n2=0,r-n0-n1
1923  n3=r-n0-n1-n2
1924  norm_coli = max(norm_coli,abs(tc(n0,n1,n2,n3)))
1925  norm_dd = max(norm_dd,abs(tc2(n0,n1,n2,n3)))
1926  end do
1927  end do
1928  end do
1929  if (norm_coli.eq.0d0) then
1930  norm_coli = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1931  if(norm_coli.ne.0d0) then
1932  norm_coli=1d0/norm_coli**(1-real(r)/2)
1933  else
1934  norm_coli=1d0/muir2_cll**(1-real(r)/2)
1935  end if
1936  end if
1937  if (norm_dd.eq.0d0) then
1938  norm_dd = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1939  if(norm_dd.ne.0d0) then
1940  norm_dd=1d0/norm_dd**(1-real(r)/2)
1941  else
1942  norm_dd=1d0/muir2_cll**(1-real(r)/2)
1943  end if
1944  end if
1945  norm(r) = min(norm_coli,norm_dd)
1946  end do
1947 
1948  call checktensors_cll(tc,tc2,momvec,mominv,masses2,norm,3,rmax,tcdiff)
1949 
1950  if (tcerr_aux(rmax).lt.tcerr_aux2(rmax)) then
1951  if (present(tcerr)) tcerr = max(tcerr_aux,tcdiff*norm)
1952  do r=0,rmax
1953  tcacc(r) = max(tcerr_aux(r)/norm(r),tcdiff(r))
1954  end do
1955  if (monitoring) pointscntcten_coli = pointscntcten_coli + 1
1956  else
1957  tc = tc2
1958  tcuv = tcuv2
1959  if (present(tcerr)) tcerr = max(tcerr_aux2,tcdiff*norm)
1960  do r=0,rmax
1961  tcacc(r) = max(tcerr_aux2(r)/norm(r),tcdiff(r))
1962  end do
1963  if (monitoring) pointscntcten_dd = pointscntcten_dd + 1
1964  end if
1965 
1966  else
1967  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
1968  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
1969  call calctensorc(tc,tcuv,tcerr_aux,cc,ccuv,ccerr,momvec,rmax)
1970  if (present(tcerr)) tcerr = tcerr_aux
1971  norm=0d0
1972  do r=0,rmax
1973  do n0=0,r
1974  do n1=0,r-n0
1975  do n2=0,r-n0-n1
1976  n3=r-n0-n1-n2
1977  norm(r) = max(norm(r),abs(tc(n0,n1,n2,n3)))
1978  end do
1979  end do
1980  end do
1981  if (norm(r).eq.0d0) then
1982  norm(r) = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
1983  if(norm(r).ne.0d0) then
1984  norm(r)=1d0/norm(r)**(1-real(r)/2)
1985  else
1986  norm(r)=1d0/muir2_cll**(1-real(r)/2)
1987  end if
1988  end if
1989  tcacc(r) = tcerr_aux(r)/norm(r)
1990  end do
1991 
1992  end if
1993 
1994  call propagateaccflag_cll(tcacc,rmax)
1995  call propagateerrflag_cll
1996 
1997  if (monitoring) then
1998  pointscntcten_cll = pointscntcten_cll + 1
1999 
2000  if(maxval(tcacc).gt.reqacc_cll) accpointscntcten_cll = accpointscntcten_cll + 1
2001 
2002  if(maxval(tcacc).gt.critacc_cll) then
2003  critpointscntcten_cll = critpointscntcten_cll + 1
2004  if ( critpointscntcten_cll.le.noutcritpointsmax_cll(3) ) then
2005  call critpointsout_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
2006  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
2007  write(ncpout_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
2008  write(ncpout_cll,*)
2009  endif
2010 #ifdef CritPoints2
2011  call critpointsout2_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
2012  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
2013  write(ncpout2_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
2014  write(ncpout2_cll,*)
2015  endif
2016 #endif
2017  end if
2018  end if
2019  end if
2020 
2021  end subroutine cten_args_cll
2022 
2023 
2024 
2025 
2026 
2027  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2028  ! subroutine Cten_args_list_cll(TC,TCuv,p1vec,p2vec,p10,p21,p20,m02,m12,m22,rmax,TCerr)
2029  !
2030  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2031 
2032  subroutine cten_args_list_cll(TC,TCuv,p1vec,p2vec,p10,p21,p20,m02,m12,m22,rmax,TCerr)
2033  integer, intent(in) :: rmax
2034  double complex, intent(in) :: p1vec(0:3), p2vec(0:3)
2035  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
2036  double complex, intent(out) :: TC(:), TCuv(:)
2037  double precision, intent(out), optional :: TCerr(0:rmax)
2038  logical :: eflag
2039 
2040  if (3.gt.nmax_cll) then
2041  call seterrflag_cll(-10)
2042  call errout_cll('Cten_cll','Nmax_cll smaller 3',eflag,.true.)
2043  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2044  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 3'
2045  call propagateerrflag_cll
2046  return
2047  end if
2048  if (rmax.gt.rmax_cll) then
2049  call seterrflag_cll(-10)
2050  call errout_cll('Cten_cll','argument rmax larger than rmax_cll',eflag,.true.)
2051  write(nerrout_cll,*) 'rmax =',rmax
2052  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2053  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2054  call propagateerrflag_cll
2055  return
2056  end if
2057 
2058  call cten_args_list_checked_cll(tc,tcuv,p1vec,p2vec,p10,p21,p20,m02,m12,m22,rmax,tcerr)
2059 
2060  end subroutine cten_args_list_cll
2061 
2062 
2063  subroutine cten_args_list_checked_cll(TC,TCuv,p1vec,p2vec,p10,p21,p20,m02,m12,m22,rmax,TCerr)
2064 
2065  integer, intent(in) :: rmax
2066  double complex, intent(in) :: p1vec(0:3), p2vec(0:3)
2067  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
2068  double complex, intent(out) :: TC(RtS(rmax)), TCuv(RtS(rmax))
2069  double precision, intent(out), optional :: TCerr(0:rmax)
2070  double complex :: TC2(RtS(rmax)), TCuv2(RtS(rmax))
2071  double complex :: MomVec(0:3,2), MomInv(3), masses2(0:2)
2072  double complex :: CC(0:rmax/2,0:rmax,0:rmax), CCuv(0:rmax/2,0:rmax,0:rmax)
2073  double precision :: CCerr(0:rmax), TCerr_aux(0:rmax), TCerr_aux2(0:rmax)
2074  double complex :: args(14)
2075  double precision :: TCdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TCacc(0:rmax)
2076  integer :: r,i
2077  logical :: eflag
2078 
2079  momvec(0:,1) = p1vec
2080  momvec(0:,2) = p2vec
2081  mominv(1) = p10
2082  mominv(2) = p21
2083  mominv(3) = p20
2084  masses2(0) = m02
2085  masses2(1) = m12
2086  masses2(2) = m22
2087 
2088  ! set ID of master call
2089  args(1:4) = momvec(0:,1)
2090  args(5:8) = momvec(0:,2)
2091  args(9:11) = mominv
2092  args(12:14) = masses2(0:)
2093  call setmasterfname_cll('Cten_cll')
2094  call setmastern_cll(3)
2095  call setmasterr_cll(rmax)
2096  call setmasterargs_cll(14,args)
2097 
2098  call settencache_cll(tenred_cll-1)
2099 
2100 
2101  if (mode_cll.eq.3) then
2102  ! calculate tensor with coefficients from COLI
2103  mode_cll = 1
2104  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
2105  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
2106  call calctensorc_list(tc,tcuv,tcerr_aux,cc,ccuv,ccerr,momvec,rmax)
2107 
2108  ! calculate tensor with coefficients from DD
2109  mode_cll = 2
2110  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
2111  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
2112  call calctensorc_list(tc2,tcuv2,tcerr_aux2,cc,ccuv,ccerr,momvec,rmax)
2113 
2114  ! comparison --> take better result
2115  mode_cll = 3
2116  do r=0,rmax
2117  norm_coli=0d0
2118  norm_dd=0d0
2119  do i=rts(r-1)+1,rts(r)
2120  norm_coli = max(norm_coli,abs(tc(i)))
2121  norm_dd = max(norm_dd,abs(tc2(i)))
2122  end do
2123  if (norm_coli.eq.0d0) then
2124  norm_coli = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
2125  if(norm_coli.ne.0d0) then
2126  norm_coli=1d0/norm_coli**(1-real(r)/2)
2127  else
2128  norm_coli=1d0/muir2_cll**(1-real(r)/2)
2129  end if
2130  end if
2131  if (norm_dd.eq.0d0) then
2132  norm_dd = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
2133  if(norm_dd.ne.0d0) then
2134  norm_dd=1d0/norm_dd**(1-real(r)/2)
2135  else
2136  norm_dd=1d0/muir2_cll**(1-real(r)/2)
2137  end if
2138  end if
2139  norm(r) = min(norm_coli,norm_dd)
2140  end do
2141 
2142  call checktensorslist_cll(tc,tc2,momvec,mominv,masses2,norm,3,rmax,tcdiff)
2143 
2144  if (tcerr_aux(rmax).lt.tcerr_aux2(rmax)) then
2145  if (present(tcerr)) tcerr = max(tcerr_aux,tcdiff*norm)
2146  do r=0,rmax
2147  tcacc(r) = max(tcerr_aux(r)/norm(r),tcdiff(r))
2148  end do
2149  if (monitoring) pointscntcten_coli = pointscntcten_coli + 1
2150  else
2151  tc = tc2
2152  tcuv = tcuv2
2153  if (present(tcerr)) tcerr = max(tcerr_aux2,tcdiff*norm)
2154  do r=0,rmax
2155  tcacc(r) = max(tcerr_aux2(r)/norm(r),tcdiff(r))
2156  end do
2157  if (monitoring) pointscntcten_dd = pointscntcten_dd + 1
2158  end if
2159 
2160  else
2161  call c_main_cll(cc,ccuv,mominv(1),mominv(2),mominv(3), &
2162  masses2(0),masses2(1),masses2(2),rmax,cerr2=ccerr,id_in=0)
2163  call calctensorc_list(tc,tcuv,tcerr,cc,ccuv,ccerr,momvec,rmax)
2164  if (present(tcerr)) tcerr = tcerr_aux
2165  norm=0d0
2166  do r=0,rmax
2167  do i=rts(r-1)+1,rts(r)
2168  norm(r) = max(norm(r),abs(tc(i)))
2169  end do
2170  if (norm(r).eq.0d0) then
2171  norm(r) = max(maxval(abs(mominv(1:3))),maxval(abs(masses2(0:2))))
2172  if(norm(r).ne.0d0) then
2173  norm(r)=1d0/norm(r)**(1-real(r)/2)
2174  else
2175  norm(r)=1d0/muir2_cll**(1-real(r)/2)
2176  end if
2177  end if
2178  tcacc(r) = tcerr_aux(r)/norm(r)
2179  end do
2180 
2181  end if
2182 
2183  call propagateaccflag_cll(tcacc,rmax)
2184  call propagateerrflag_cll
2185 
2186  if (monitoring) then
2187  pointscntcten_cll = pointscntcten_cll + 1
2188 
2189  if(maxval(tcacc).gt.reqacc_cll) accpointscntcten_cll = accpointscntcten_cll + 1
2190 
2191  if(maxval(tcacc).gt.critacc_cll) then
2192  critpointscntcten_cll = critpointscntcten_cll + 1
2193  if ( critpointscntcten_cll.le.noutcritpointsmax_cll(3) ) then
2194  call critpointsout_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
2195  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
2196  write(ncpout_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
2197  write(ncpout_cll,*)
2198  endif
2199 #ifdef CritPoints2
2200  call critpointsout2_cll('TCten_cll',0,maxval(tcacc),critpointscntcten_cll)
2201  if( critpointscntcten_cll.eq.noutcritpointsmax_cll(3)) then
2202  write(ncpout2_cll,*) ' Further output of Critical Points for TCten_cll suppressed'
2203  write(ncpout2_cll,*)
2204  endif
2205 #endif
2206  end if
2207  end if
2208  end if
2209 
2210  end subroutine cten_args_list_checked_cll
2211 
2212 
2213 
2214 
2215 
2216  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2217  ! subroutine Dten_main_cll(TD,TDuv,MomVec,MomInv,masses2,rmax,TDerr)
2218  !
2219  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2220 
2221  subroutine dten_main_cll(TD,TDuv,MomVec,MomInv,masses2,rmax,TDerr)
2222 
2223  integer, intent(in) :: rmax
2224  double complex, intent(in) :: MomVec(0:3,3), MomInv(6), masses2(0:3)
2225  double complex, intent(out) :: TD(0:rmax,0:rmax,0:rmax,0:rmax)
2226  double complex, intent(out) :: TDuv(0:rmax,0:rmax,0:rmax,0:rmax)
2227  double precision, intent(out), optional :: TDerr(0:rmax)
2228  double complex :: CD(0:rmax/2,0:rmax,0:rmax,0:rmax)
2229  double complex :: TD2(0:rmax,0:rmax,0:rmax,0:rmax), TDuv2(0:rmax,0:rmax,0:rmax,0:rmax)
2230  double complex :: CDuv(0:rmax/2,0:rmax,0:rmax,0:rmax)
2231  double precision :: CDerr(0:rmax), TDerr_aux(0:rmax), TDerr_aux2(0:rmax)
2232  double complex :: args(22)
2233  double precision :: TDdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TDacc(0:rmax)
2234  integer :: r,n0,n1,n2,n3
2235  logical :: eflag
2236 
2237  if (4.gt.nmax_cll) then
2238  call seterrflag_cll(-10)
2239  call errout_cll('Dten_cll','Nmax_cll smaller 4',eflag,.true.)
2240  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2241  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
2242  call propagateerrflag_cll
2243  return
2244  end if
2245  if (rmax.gt.rmax_cll) then
2246  call seterrflag_cll(-10)
2247  call errout_cll('Dten_cll','argument rmax larger than rmax_cll',eflag,.true.)
2248  write(nerrout_cll,*) 'rmax =',rmax
2249  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2250  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2251  call propagateerrflag_cll
2252  return
2253  end if
2254 
2255  ! set ID of master call
2256  args(1:4) = momvec(0:,1)
2257  args(5:8) = momvec(0:,2)
2258  args(9:12) = momvec(0:,3)
2259  args(13:18) = mominv
2260  args(19:22) = masses2(0:)
2261  call setmasterfname_cll('Dten_cll')
2262  call setmastern_cll(4)
2263  call setmasterr_cll(rmax)
2264  call setmasterargs_cll(22,args)
2265 
2266  call settencache_cll(tenred_cll-1)
2267 
2268  if (mode_cll.eq.3) then
2269  ! calculate tensor with coefficients from COLI
2270  mode_cll = 1
2271  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2272  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2273  call calctensord(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2274 
2275  ! calculate tensor with coefficients from DD
2276  mode_cll = 2
2277  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2278  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2279  call calctensord(td2,tduv2,tderr_aux2,cd,cduv,cderr,momvec,rmax)
2280 
2281  ! comparison --> take better result
2282  mode_cll = 3
2283  do r=0,rmax
2284  norm_coli=0d0
2285  norm_dd=0d0
2286  do n0=0,r
2287  do n1=0,r-n0
2288  do n2=0,r-n0-n1
2289  n3=r-n0-n1-n2
2290  norm_coli = max(norm_coli,abs(td(n0,n1,n2,n3)))
2291  norm_dd = max(norm_dd,abs(td2(n0,n1,n2,n3)))
2292  end do
2293  end do
2294  end do
2295  if (norm_coli.eq.0d0) then
2296  norm_coli = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2297  if(norm_coli.ne.0d0) then
2298  norm_coli=1d0/norm_coli**(2-real(r)/2)
2299  else
2300  norm_coli=1d0/muir2_cll**(2-real(r)/2)
2301  end if
2302  end if
2303  if (norm_dd.eq.0d0) then
2304  norm_dd = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2305  if(norm_dd.ne.0d0) then
2306  norm_dd=1d0/norm_dd**(2-real(r)/2)
2307  else
2308  norm_dd=1d0/muir2_cll**(2-real(r)/2)
2309  end if
2310  end if
2311  norm(r) = min(norm_coli,norm_dd)
2312  end do
2313 
2314  call checktensors_cll(td,td2,momvec,mominv,masses2,norm,4,rmax,tddiff)
2315 
2316  if (tderr_aux(rmax).lt.tderr_aux2(rmax)) then
2317  if (present(tderr)) tderr = max(tderr_aux,tddiff*norm)
2318  do r=0,rmax
2319  tdacc(r) = max(tderr_aux(r)/norm(r),tddiff(r))
2320  end do
2321  if (monitoring) pointscntdten_coli = pointscntdten_coli + 1
2322  else
2323  td = td2
2324  tduv = tduv2
2325  if (present(tderr)) tderr = max(tderr_aux2,tddiff*norm)
2326  do r=0,rmax
2327  tdacc(r) = max(tderr_aux2(r)/norm(r),tddiff(r))
2328  end do
2329  if (monitoring) pointscntdten_dd = pointscntdten_dd + 1
2330  end if
2331 
2332  else
2333  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2334  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2335  call calctensord(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2336  if (present(tderr)) tderr = tderr_aux
2337  norm=0d0
2338  do r=0,rmax
2339  do n0=0,r
2340  do n1=0,r-n0
2341  do n2=0,r-n0-n1
2342  n3=r-n0-n1-n2
2343  norm(r) = max(norm(r),abs(td(n0,n1,n2,n3)))
2344  end do
2345  end do
2346  end do
2347  if (norm(r).eq.0d0) then
2348  norm(r) = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2349  if(norm(r).ne.0d0) then
2350  norm(r)=1d0/norm(r)**(2-real(r)/2)
2351  else
2352  norm(r)=1d0/muir2_cll**(2-real(r)/2)
2353  end if
2354  end if
2355  tdacc(r) = tderr_aux(r)/norm(r)
2356  end do
2357 
2358  end if
2359 
2360  call propagateaccflag_cll(tdacc,rmax)
2361  call propagateerrflag_cll
2362 
2363  if (monitoring) then
2364  pointscntdten_cll = pointscntdten_cll + 1
2365 
2366  if(maxval(tdacc).gt.reqacc_cll) accpointscntdten_cll = accpointscntdten_cll + 1
2367 
2368  if(maxval(tdacc).gt.critacc_cll) then
2369  critpointscntdten_cll = critpointscntdten_cll + 1
2370  if ( critpointscntdten_cll.le.noutcritpointsmax_cll(4) ) then
2371  call critpointsout_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2372  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2373  write(ncpout_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2374  write(ncpout_cll,*)
2375  endif
2376 #ifdef CritPoints2
2377  call critpointsout2_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2378  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2379  write(ncpout2_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2380  write(ncpout2_cll,*)
2381  endif
2382 #endif
2383  end if
2384  end if
2385  end if
2386 
2387  end subroutine dten_main_cll
2388 
2389 
2390 
2391 
2392 
2393  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2394  ! subroutine Dten_list_cll(TD,TDuv,MomVec,MomInv,masses2,rmax,TDerr)
2395  !
2396  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2397 
2398 
2399  subroutine dten_list_cll(TD,TDuv,MomVec,MomInv,masses2,rmax,TDerr)
2400 
2401  integer, intent(in) :: rmax
2402  double complex, intent(in) :: MomVec(0:3,3), MomInv(6), masses2(0:3)
2403  double complex, intent(out) :: TD(:), TDuv(:)
2404  double precision, intent(out), optional :: TDerr(0:rmax)
2405  logical :: eflag
2406 
2407  if (4.gt.nmax_cll) then
2408  call seterrflag_cll(-10)
2409  call errout_cll('Dten_cll','Nmax_cll smaller 4',eflag,.true.)
2410  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2411  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
2412  call propagateerrflag_cll
2413  return
2414  end if
2415  if (rmax.gt.rmax_cll) then
2416  call seterrflag_cll(-10)
2417  call errout_cll('Dten_cll','argument rmax larger than rmax_cll',eflag,.true.)
2418  write(nerrout_cll,*) 'rmax =',rmax
2419  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2420  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2421  call propagateerrflag_cll
2422  return
2423  end if
2424 
2425  call dten_list_checked_cll(td,tduv,momvec,mominv,masses2,rmax,tderr)
2426 
2427  end subroutine dten_list_cll
2428 
2429 
2430  subroutine dten_list_checked_cll(TD,TDuv,MomVec,MomInv,masses2,rmax,TDerr)
2431 
2432  integer, intent(in) :: rmax
2433  double complex, intent(in) :: MomVec(0:3,3), MomInv(6), masses2(0:3)
2434  double complex, intent(out) :: TD(RtS(rmax)), TDuv(RtS(rmax))
2435  double precision, intent(out), optional :: TDerr(0:rmax)
2436  double complex :: TD2(RtS(rmax)), TDuv2(RtS(rmax))
2437  double complex :: CD(0:rmax/2,0:rmax,0:rmax,0:rmax)
2438  double complex :: CDuv(0:rmax/2,0:rmax,0:rmax,0:rmax)
2439  double precision :: CDerr(0:rmax), TDerr_aux(0:rmax), TDerr_aux2(0:rmax)
2440  double complex :: args(22)
2441  double precision :: TDdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TDacc(0:rmax)
2442  integer :: r,i
2443 
2444  ! set ID of master call
2445  args(1:4) = momvec(0:,1)
2446  args(5:8) = momvec(0:,2)
2447  args(9:12) = momvec(0:,3)
2448  args(13:18) = mominv
2449  args(19:22) = masses2(0:)
2450  call setmasterfname_cll('Dten_cll')
2451  call setmastern_cll(4)
2452  call setmasterr_cll(rmax)
2453  call setmasterargs_cll(22,args)
2454 
2455  call settencache_cll(tenred_cll-1)
2456 
2457 
2458  if (mode_cll.eq.3) then
2459  ! calculate tensor with coefficients from COLI
2460  mode_cll = 1
2461  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2462  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2463  call calctensord_list(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2464 
2465  ! calculate tensor with coefficients from DD
2466  mode_cll = 2
2467  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2468  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2469  call calctensord_list(td2,tduv2,tderr_aux2,cd,cduv,cderr,momvec,rmax)
2470 
2471  ! comparison --> take better result
2472  mode_cll = 3
2473  do r=0,rmax
2474  norm_coli=0d0
2475  norm_dd=0d0
2476  do i=rts(r-1)+1,rts(r)
2477  norm_coli = max(norm_coli,abs(td(i)))
2478  norm_dd = max(norm_dd,abs(td2(i)))
2479  end do
2480  if (norm_coli.eq.0d0) then
2481  norm_coli = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2482  if(norm_coli.ne.0d0) then
2483  norm_coli=1d0/norm_coli**(2-real(r)/2)
2484  else
2485  norm_coli=1d0/muir2_cll**(2-real(r)/2)
2486  end if
2487  end if
2488  if (norm_dd.eq.0d0) then
2489  norm_dd = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2490  if(norm_dd.ne.0d0) then
2491  norm_dd=1d0/norm_dd**(2-real(r)/2)
2492  else
2493  norm_dd=1d0/muir2_cll**(2-real(r)/2)
2494  end if
2495  end if
2496  norm(r) = min(norm_coli,norm_dd)
2497  end do
2498 
2499  call checktensorslist_cll(td,td2,momvec,mominv,masses2,norm,4,rmax,tddiff)
2500 
2501  if (tderr_aux(rmax).lt.tderr_aux2(rmax)) then
2502  if (present(tderr)) tderr = max(tderr_aux,tddiff*norm)
2503  do r=0,rmax
2504  tdacc(r) = max(tderr_aux(r)/norm(r),tddiff(r))
2505  end do
2506  if (monitoring) pointscntdten_coli = pointscntdten_coli + 1
2507  else
2508  td = td2
2509  tduv = tduv2
2510  if (present(tderr)) tderr = max(tderr_aux2,tddiff*norm)
2511  do r=0,rmax
2512  tdacc(r) = max(tderr_aux2(r)/norm(r),tddiff(r))
2513  end do
2514  if (monitoring) pointscntdten_dd = pointscntdten_dd + 1
2515  end if
2516 
2517  else
2518  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2519  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2520  call calctensord_list(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2521  if (present(tderr)) tderr = tderr_aux
2522  norm=0d0
2523  do r=0,rmax
2524  do i=rts(r-1)+1,rts(r)
2525  norm(r) = max(norm(r),abs(td(i)))
2526  end do
2527  if (norm(r).eq.0d0) then
2528  norm(r) = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2529  if(norm(r).ne.0d0) then
2530  norm(r)=1d0/norm(r)**(2-real(r)/2)
2531  else
2532  norm(r)=1d0/muir2_cll**(2-real(r)/2)
2533  end if
2534  end if
2535  tdacc(r) = tderr_aux(r)/norm(r)
2536  end do
2537 
2538  end if
2539 
2540  call propagateaccflag_cll(tdacc,rmax)
2541  call propagateerrflag_cll
2542 
2543  if (monitoring) then
2544  pointscntdten_cll = pointscntdten_cll + 1
2545 
2546  if(maxval(tdacc).gt.reqacc_cll) accpointscntdten_cll = accpointscntdten_cll + 1
2547 
2548  if(maxval(tdacc).gt.critacc_cll) then
2549  critpointscntdten_cll = critpointscntdten_cll + 1
2550  if ( critpointscntdten_cll.le.noutcritpointsmax_cll(4) ) then
2551  call critpointsout_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2552  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2553  write(ncpout_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2554  write(ncpout_cll,*)
2555  endif
2556 #ifdef CritPoints2
2557  call critpointsout2_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2558  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2559  write(ncpout2_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2560  write(ncpout2_cll,*)
2561  endif
2562 #endif
2563  end if
2564  end if
2565  end if
2566 
2567  end subroutine dten_list_checked_cll
2568 
2569 
2570 
2571 
2572 
2573  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2574  ! subroutine Dten_args_cll(TC,TCuv,p1vec,p2vec,p10,p21,p20,m02,m12,m22,rmax,TDerr)
2575  !
2576  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2577 
2578  subroutine dten_args_cll(TD,TDuv,p1vec,p2vec,p3vec,p10,p21,p32,p30,p20,p31, &
2579  m02,m12,m22,m32,rmax,TDerr)
2580 
2581  integer, intent(in) :: rmax
2582  double complex, intent(in) :: p1vec(0:3), p2vec(0:3), p3vec(0:3)
2583  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
2584  double complex, intent(out) :: TD(0:rmax,0:rmax,0:rmax,0:rmax)
2585  double complex, intent(out) :: TDuv(0:rmax,0:rmax,0:rmax,0:rmax)
2586  double precision, intent(out), optional :: TDerr(0:rmax)
2587  double complex TD2(0:rmax,0:rmax,0:rmax,0:rmax), TDuv2(0:rmax,0:rmax,0:rmax,0:rmax)
2588  double complex :: MomVec(0:3,3), MomInv(6), masses2(0:3)
2589  double complex :: CD(0:rmax/2,0:rmax,0:rmax,0:rmax)
2590  double complex :: CDuv(0:rmax/2,0:rmax,0:rmax,0:rmax)
2591  double precision :: CDerr(0:rmax), TDerr_aux(0:rmax), TDerr_aux2(0:rmax)
2592  double complex :: args(22)
2593  double precision :: TDdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TDacc(0:rmax)
2594  integer :: r,n0,n1,n2,n3
2595  logical :: eflag
2596 
2597  if (4.gt.nmax_cll) then
2598  call seterrflag_cll(-10)
2599  call errout_cll('Dten_cll','Nmax_cll smaller 4',eflag,.true.)
2600  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2601  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
2602  call propagateerrflag_cll
2603  return
2604  end if
2605  if (rmax.gt.rmax_cll) then
2606  call seterrflag_cll(-10)
2607  call errout_cll('Dten_cll','argument rmax larger than rmax_cll',eflag,.true.)
2608  write(nerrout_cll,*) 'rmax =',rmax
2609  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2610  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2611  call propagateerrflag_cll
2612  return
2613  end if
2614 
2615  momvec(0:,1) = p1vec
2616  momvec(0:,2) = p2vec
2617  momvec(0:,3) = p3vec
2618  mominv(1) = p10
2619  mominv(2) = p21
2620  mominv(3) = p32
2621  mominv(4) = p30
2622  mominv(5) = p20
2623  mominv(6) = p31
2624  masses2(0) = m02
2625  masses2(1) = m12
2626  masses2(2) = m22
2627  masses2(3) = m32
2628 
2629  ! set ID of master call
2630  args(1:4) = momvec(0:,1)
2631  args(5:8) = momvec(0:,2)
2632  args(9:12) = momvec(0:,3)
2633  args(13:18) = mominv
2634  args(19:22) = masses2(0:)
2635  call setmasterfname_cll('Dten_cll')
2636  call setmastern_cll(4)
2637  call setmasterr_cll(rmax)
2638  call setmasterargs_cll(22,args)
2639 
2640  call settencache_cll(tenred_cll-1)
2641 
2642 
2643  if (mode_cll.eq.3) then
2644  ! calculate tensor with coefficients from COLI
2645  mode_cll = 1
2646  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2647  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2648  call calctensord(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2649 
2650  ! calculate tensor with coefficients from DD
2651  mode_cll = 2
2652  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2653  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2654  call calctensord(td2,tduv2,tderr_aux2,cd,cduv,cderr,momvec,rmax)
2655 
2656  ! comparison --> take better result
2657  mode_cll = 3
2658  do r=0,rmax
2659  norm_coli=0d0
2660  norm_dd=0d0
2661  do n0=0,r
2662  do n1=0,r-n0
2663  do n2=0,r-n0-n1
2664  n3=r-n0-n1-n2
2665  norm_coli = max(norm_coli,abs(td(n0,n1,n2,n3)))
2666  norm_dd = max(norm_dd,abs(td2(n0,n1,n2,n3)))
2667  end do
2668  end do
2669  end do
2670  if (norm_coli.eq.0d0) then
2671  norm_coli = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2672  if(norm_coli.ne.0d0) then
2673  norm_coli=1d0/norm_coli**(2-real(r)/2)
2674  else
2675  norm_coli=1d0/muir2_cll**(2-real(r)/2)
2676  end if
2677  end if
2678  if (norm_dd.eq.0d0) then
2679  norm_dd = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2680  if(norm_dd.ne.0d0) then
2681  norm_dd=1d0/norm_dd**(2-real(r)/2)
2682  else
2683  norm_dd=1d0/muir2_cll**(2-real(r)/2)
2684  end if
2685  end if
2686  norm(r) = min(norm_coli,norm_dd)
2687  end do
2688 
2689  call checktensors_cll(td,td2,momvec,mominv,masses2,norm,4,rmax,tddiff)
2690 
2691  if (tderr_aux(rmax).lt.tderr_aux2(rmax)) then
2692  if (present(tderr)) tderr = max(tderr_aux,tddiff*norm)
2693  do r=0,rmax
2694  tdacc(r) = max(tderr_aux(r)/norm(r),tddiff(r))
2695  end do
2696  if (monitoring) pointscntdten_coli = pointscntdten_coli + 1
2697  else
2698  td = td2
2699  tduv = tduv2
2700  if (present(tderr)) tderr = max(tderr_aux2,tddiff*norm)
2701  do r=0,rmax
2702  tdacc(r) = max(tderr_aux2(r)/norm(r),tddiff(r))
2703  end do
2704  if (monitoring) pointscntdten_dd = pointscntdten_dd + 1
2705  end if
2706 
2707  else
2708  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2709  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2710 
2711  call calctensord(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2712  if (present(tderr)) tderr = tderr_aux
2713  norm=0d0
2714  do r=0,rmax
2715  do n0=0,r
2716  do n1=0,r-n0
2717  do n2=0,r-n0-n1
2718  n3=r-n0-n1-n2
2719  norm(r) = max(norm(r),abs(td(n0,n1,n2,n3)))
2720  end do
2721  end do
2722  end do
2723  if (norm(r).eq.0d0) then
2724  norm(r) = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2725  if(norm(r).ne.0d0) then
2726  norm(r)=1d0/norm(r)**(2-real(r)/2)
2727  else
2728  norm(r)=1d0/muir2_cll**(2-real(r)/2)
2729  end if
2730  end if
2731  tdacc(r) = tderr_aux(r)/norm(r)
2732  end do
2733 
2734  end if
2735 
2736  call propagateaccflag_cll(tdacc,rmax)
2737  call propagateerrflag_cll
2738 
2739  if (monitoring) then
2740  pointscntdten_cll = pointscntdten_cll + 1
2741 
2742  if(maxval(tdacc).gt.reqacc_cll) accpointscntdten_cll = accpointscntdten_cll + 1
2743 
2744  if(maxval(tdacc).gt.critacc_cll) then
2745  critpointscntdten_cll = critpointscntdten_cll + 1
2746  if ( critpointscntdten_cll.le.noutcritpointsmax_cll(4) ) then
2747  call critpointsout_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2748  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2749  write(ncpout_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2750  write(ncpout_cll,*)
2751  endif
2752 #ifdef CritPoints2
2753  call critpointsout2_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2754  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2755  write(ncpout2_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2756  write(ncpout2_cll,*)
2757  endif
2758 #endif
2759  end if
2760  end if
2761  end if
2762 
2763  end subroutine dten_args_cll
2764 
2765 
2766 
2767 
2768 
2769  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2770  ! subroutine Dten_args_list_cll(TD,TDuv,p1vec,p2vec,p3vec,p10,p21,p32,p30,p20,p31, &
2771  ! m02,m12,m22,m32,rmax,TDerr)
2772  !
2773  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2774 
2775  subroutine dten_args_list_cll(TD,TDuv,p1vec,p2vec,p3vec,p10,p21,p32,p30,p20,p31, &
2776  m02,m12,m22,m32,rmax,TDerr)
2777  integer, intent(in) :: rmax
2778  double complex, intent(in) :: p1vec(0:3), p2vec(0:3), p3vec(0:3)
2779  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
2780  double complex, intent(out) :: TD(:), TDuv(:)
2781  double precision, intent(out), optional :: TDerr(0:rmax)
2782  logical :: eflag
2783 
2784  if (4.gt.nmax_cll) then
2785  call seterrflag_cll(-10)
2786  call errout_cll('Dten_cll','Nmax_cll smaller 4',eflag,.true.)
2787  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2788  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 4'
2789  call propagateerrflag_cll
2790  return
2791  end if
2792  if (rmax.gt.rmax_cll) then
2793  call seterrflag_cll(-10)
2794  call errout_cll('Dten_cll','argument rmax larger than rmax_cll',eflag,.true.)
2795  write(nerrout_cll,*) 'rmax =',rmax
2796  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
2797  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
2798  call propagateerrflag_cll
2799  return
2800  end if
2801 
2802  call dten_args_list_checked_cll(td,tduv,p1vec,p2vec,p3vec,p10,p21,p32,p30,p20,p31, &
2803  m02,m12,m22,m32,rmax,tderr)
2804 
2805  end subroutine dten_args_list_cll
2806 
2807 
2808  subroutine dten_args_list_checked_cll(TD,TDuv,p1vec,p2vec,p3vec,p10,p21,p32,p30,p20,p31, &
2809  m02,m12,m22,m32,rmax,TDerr)
2810  integer, intent(in) :: rmax
2811  double complex, intent(in) :: p1vec(0:3), p2vec(0:3), p3vec(0:3)
2812  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
2813  double complex, intent(out) :: TD(RtS(rmax)), TDuv(RtS(rmax))
2814  double precision, intent(out), optional :: TDerr(0:rmax)
2815  double complex :: TD2(RtS(rmax)), TDuv2(RtS(rmax))
2816  double complex :: MomVec(0:3,3), MomInv(6), masses2(0:3)
2817  double complex :: CD(0:rmax/2,0:rmax,0:rmax,0:rmax)
2818  double complex :: CDuv(0:rmax/2,0:rmax,0:rmax,0:rmax)
2819  double precision :: CDerr(0:rmax), TDerr_aux(0:rmax), TDerr_aux2(0:rmax)
2820  double complex :: args(22)
2821  double precision :: TDdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TDacc(0:rmax)
2822  integer :: r,i
2823 
2824  momvec(0:,1) = p1vec
2825  momvec(0:,2) = p2vec
2826  momvec(0:,3) = p3vec
2827  mominv(1) = p10
2828  mominv(2) = p21
2829  mominv(3) = p32
2830  mominv(4) = p30
2831  mominv(5) = p20
2832  mominv(6) = p31
2833  masses2(0) = m02
2834  masses2(1) = m12
2835  masses2(2) = m22
2836  masses2(3) = m32
2837 
2838  ! set ID of master call
2839  args(1:4) = momvec(0:,1)
2840  args(5:8) = momvec(0:,2)
2841  args(9:12) = momvec(0:,3)
2842  args(13:18) = mominv
2843  args(19:22) = masses2(0:)
2844  call setmasterfname_cll('Dten_cll')
2845  call setmastern_cll(4)
2846  call setmasterr_cll(rmax)
2847  call setmasterargs_cll(22,args)
2848 
2849  call settencache_cll(tenred_cll-1)
2850 
2851 
2852  if (mode_cll.eq.3) then
2853  ! calculate tensor with coefficients from COLI
2854  mode_cll = 1
2855  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2856  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2857  call calctensord_list(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2858 
2859  ! calculate tensor with coefficients from DD
2860  mode_cll = 2
2861  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2862  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2863  call calctensord_list(td2,tduv2,tderr_aux2,cd,cduv,cderr,momvec,rmax)
2864 
2865  ! comparison --> take better result
2866  mode_cll = 3
2867  do r=0,rmax
2868  norm_coli=0d0
2869  norm_dd=0d0
2870  do i=rts(r-1)+1,rts(r)
2871  norm_coli = max(norm_coli,abs(td(i)))
2872  norm_dd = max(norm_dd,abs(td2(i)))
2873  end do
2874  if (norm_coli.eq.0d0) then
2875  norm_coli = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2876  if(norm_coli.ne.0d0) then
2877  norm_coli=1d0/norm_coli**(2-real(r)/2)
2878  else
2879  norm_coli=1d0/muir2_cll**(2-real(r)/2)
2880  end if
2881  end if
2882  if (norm_dd.eq.0d0) then
2883  norm_dd = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2884  if(norm_dd.ne.0d0) then
2885  norm_dd=1d0/norm_dd**(2-real(r)/2)
2886  else
2887  norm_dd=1d0/muir2_cll**(2-real(r)/2)
2888  end if
2889  end if
2890  norm(r) = min(norm_coli,norm_dd)
2891  end do
2892 
2893  call checktensorslist_cll(td,td2,momvec,mominv,masses2,norm,4,rmax,tddiff)
2894 
2895  if (tderr_aux(rmax).lt.tderr_aux2(rmax)) then
2896  if (present(tderr)) tderr = max(tderr_aux,tddiff*norm)
2897  do r=0,rmax
2898  tdacc(r) = max(tderr_aux(r)/norm(r),tddiff(r))
2899  end do
2900  if (monitoring) pointscntdten_coli = pointscntdten_coli + 1
2901  else
2902  td = td2
2903  tduv = tduv2
2904  if (present(tderr)) tderr = max(tderr_aux2,tddiff*norm)
2905  do r=0,rmax
2906  tdacc(r) = max(tderr_aux2(r)/norm(r),tddiff(r))
2907  end do
2908  if (monitoring) pointscntdten_dd = pointscntdten_dd + 1
2909  end if
2910 
2911  else
2912  call d_main_cll(cd,cduv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
2913  masses2(0),masses2(1),masses2(2),masses2(3),rmax,derr2=cderr,id_in=0)
2914 
2915  call calctensord_list(td,tduv,tderr_aux,cd,cduv,cderr,momvec,rmax)
2916  if (present(tderr)) tderr = tderr_aux
2917  norm=0d0
2918  do r=0,rmax
2919  do i=rts(r-1)+1,rts(r)
2920  norm(r) = max(norm(r),abs(td(i)))
2921  end do
2922  if (norm(r).eq.0d0) then
2923  norm(r) = max(maxval(abs(mominv(1:6))),maxval(abs(masses2(0:3))))
2924  if(norm(r).ne.0d0) then
2925  norm(r)=1d0/norm(r)**(2-real(r)/2)
2926  else
2927  norm(r)=1d0/muir2_cll**(2-real(r)/2)
2928  end if
2929  end if
2930  tdacc(r) = tderr_aux(r)/norm(r)
2931  end do
2932 
2933  end if
2934 
2935  call propagateaccflag_cll(tdacc,rmax)
2936  call propagateerrflag_cll
2937 
2938  if (monitoring) then
2939  pointscntdten_cll = pointscntdten_cll + 1
2940 
2941  if(maxval(tdacc).gt.reqacc_cll) accpointscntdten_cll = accpointscntdten_cll + 1
2942 
2943  if(maxval(tdacc).gt.critacc_cll) then
2944  critpointscntdten_cll = critpointscntdten_cll + 1
2945  if ( critpointscntdten_cll.le.noutcritpointsmax_cll(4) ) then
2946  call critpointsout_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2947  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2948  write(ncpout_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2949  write(ncpout_cll,*)
2950  endif
2951 #ifdef CritPoints2
2952  call critpointsout2_cll('TDten_cll',0,maxval(tdacc),critpointscntdten_cll)
2953  if( critpointscntdten_cll.eq.noutcritpointsmax_cll(4)) then
2954  write(ncpout2_cll,*) ' Further output of Critical Points for TDten_cll suppressed'
2955  write(ncpout2_cll,*)
2956  endif
2957 #endif
2958  end if
2959  end if
2960  end if
2961 
2962  end subroutine dten_args_list_checked_cll
2963 
2964 
2965 
2966 
2967 
2968  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2969  ! subroutine Eten_main_cll(TE,TEuv,MomVec,MomInv,masses2,rmax,TEerr)
2970  !
2971  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2972 
2973  subroutine eten_main_cll(TE,TEuv,MomVec,MomInv,masses2,rmax,TEerr)
2974 
2975  integer, intent(in) :: rmax
2976  double complex, intent(in) :: MomVec(0:3,4), MomInv(10), masses2(0:4)
2977  double complex, intent(out) :: TE(0:rmax,0:rmax,0:rmax,0:rmax)
2978  double complex, intent(out) :: TEuv(0:rmax,0:rmax,0:rmax,0:rmax)
2979  double precision, intent(out), optional :: TEerr(0:rmax)
2980  double complex :: TE2(0:rmax,0:rmax,0:rmax,0:rmax), TEuv2(0:rmax,0:rmax,0:rmax,0:rmax)
2981  double complex :: CE(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2982  double complex :: CEuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
2983  double precision :: CEerr(0:rmax), TEerr_aux(0:rmax), TEerr_aux2(0:rmax)
2984  double complex :: args(31)
2985  double precision :: TEdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TEacc(0:rmax)
2986  integer :: r,n0,n1,n2,n3
2987  logical :: eflag
2988 
2989  if (5.gt.nmax_cll) then
2990  call seterrflag_cll(-10)
2991  call errout_cll('Eten_cll','Nmax_cll smaller 5',eflag,.true.)
2992  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
2993  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 5'
2994  call propagateerrflag_cll
2995  return
2996  end if
2997  if (rmax.gt.rmax_cll) then
2998  call seterrflag_cll(-10)
2999  call errout_cll('Eten_cll','argument rmax larger than rmax_cll',eflag,.true.)
3000  write(nerrout_cll,*) 'rmax =',rmax
3001  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3002  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3003  call propagateerrflag_cll
3004  return
3005  end if
3006 
3007  ! set ID of master call
3008  args(1:4) = momvec(0:,1)
3009  args(5:8) = momvec(0:,2)
3010  args(9:12) = momvec(0:,3)
3011  args(13:16) = momvec(0:,4)
3012  args(17:26) = mominv
3013  args(27:31) = masses2
3014  call setmasterfname_cll('Eten_cll')
3015  call setmastern_cll(5)
3016  call setmasterr_cll(rmax)
3017  call setmasterargs_cll(31,args)
3018 
3019  call settencache_cll(tenred_cll-1)
3020 
3021  if (mode_cll.eq.3) then
3022  ! calculate tensor with coefficients from COLI
3023  mode_cll = 1
3024  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3025  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3026  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3027  call calctensore(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3028 
3029  ! calculate tensor with coefficients from DD
3030  mode_cll = 2
3031  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3032  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3033  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3034  call calctensore(te2,teuv2,teerr_aux2,ce,ceuv,ceerr,momvec,rmax)
3035 
3036  ! comparison --> take better result
3037  mode_cll = 3
3038  do r=0,rmax
3039  norm_coli=0d0
3040  norm_dd=0d0
3041  do n0=0,r
3042  do n1=0,r-n0
3043  do n2=0,r-n0-n1
3044  n3=r-n0-n1-n2
3045  norm_coli = max(norm_coli,abs(te(n0,n1,n2,n3)))
3046  norm_dd = max(norm_dd,abs(te2(n0,n1,n2,n3)))
3047  end do
3048  end do
3049  end do
3050  if (norm_coli.eq.0d0) then
3051  norm_coli = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3052  if(norm_coli.ne.0d0) then
3053  norm_coli=1d0/norm_coli**(3-real(r)/2)
3054  else
3055  norm_coli=1d0/muir2_cll**(3-real(r)/2)
3056  end if
3057  end if
3058  if (norm_dd.eq.0d0) then
3059  norm_dd = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3060  if(norm_dd.ne.0d0) then
3061  norm_dd=1d0/norm_dd**(3-real(r)/2)
3062  else
3063  norm_dd=1d0/muir2_cll**(3-real(r)/2)
3064  end if
3065  end if
3066  norm(r) = min(norm_coli,norm_dd)
3067  end do
3068 
3069  call checktensors_cll(te,te2,momvec,mominv,masses2,norm,5,rmax,tediff)
3070 
3071  if (teerr_aux(rmax).lt.teerr_aux2(rmax)) then
3072  if (present(teerr)) teerr = max(teerr_aux,tediff*norm)
3073  do r=0,rmax
3074  teacc(r) = max(teerr_aux(r)/norm(r),tediff(r))
3075  end do
3076  if (monitoring) pointscnteten_coli = pointscnteten_coli + 1
3077  else
3078  te = te2
3079  teuv = teuv2
3080  if (present(teerr)) teerr = max(teerr_aux2,tediff*norm)
3081  do r=0,rmax
3082  teacc(r) = max(teerr_aux2(r)/norm(r),tediff(r))
3083  end do
3084  if (monitoring) pointscnteten_dd = pointscnteten_dd + 1
3085  end if
3086 
3087  else
3088  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3089  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3090  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3091  call calctensore(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3092  if (present(teerr)) teerr = teerr_aux
3093  norm = 0d0
3094  do r=0,rmax
3095  do n0=0,r
3096  do n1=0,r-n0
3097  do n2=0,r-n0-n1
3098  n3=r-n0-n1-n2
3099  norm(r) = max(norm(r),abs(te(n0,n1,n2,n3)))
3100  end do
3101  end do
3102  end do
3103  if (norm(r).eq.0d0) then
3104  norm(r) = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3105  if(norm(r).ne.0d0) then
3106  norm(r)=1d0/norm(r)**(3-real(r)/2)
3107  else
3108  norm(r)=1d0/muir2_cll**(3-real(r)/2)
3109  end if
3110  end if
3111  teacc(r) = teerr_aux(r)/norm(r)
3112  end do
3113 
3114  end if
3115 
3116  call propagateaccflag_cll(teacc,rmax)
3117  call propagateerrflag_cll
3118 
3119  if (monitoring) then
3120  pointscnteten_cll = pointscnteten_cll + 1
3121 
3122  if(maxval(teacc).gt.reqacc_cll) accpointscnteten_cll = accpointscnteten_cll + 1
3123 
3124  if(maxval(teacc).gt.critacc_cll) then
3125  critpointscnteten_cll = critpointscnteten_cll + 1
3126  if ( critpointscnteten_cll.le.noutcritpointsmax_cll(5) ) then
3127  call critpointsout_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3128  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3129  write(ncpout_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3130  write(ncpout_cll,*)
3131  endif
3132 #ifdef CritPoints2
3133  call critpointsout2_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3134  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3135  write(ncpout2_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3136  write(ncpout2_cll,*)
3137  endif
3138 #endif
3139  end if
3140  end if
3141  end if
3142 
3143  end subroutine eten_main_cll
3144 
3145 
3146 
3147 
3148 
3149  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3150  ! subroutine Eten_list_cll(TE,TEuv,MomVec,MomInv,masses2,rmax,TEerr)
3151  !
3152  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3153 
3154  subroutine eten_list_cll(TE,TEuv,MomVec,MomInv,masses2,rmax,TEerr)
3155 
3156  integer, intent(in) :: rmax
3157  double complex, intent(in) :: MomVec(0:3,4), MomInv(10), masses2(0:4)
3158  double complex, intent(out) :: TE(:), TEuv(:)
3159  double precision, intent(out), optional :: TEerr(0:rmax)
3160  integer :: r,i
3161  logical :: eflag
3162 
3163  if (5.gt.nmax_cll) then
3164  call seterrflag_cll(-10)
3165  call errout_cll('Eten_cll','Nmax_cll smaller 5',eflag,.true.)
3166  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3167  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 5'
3168  call propagateerrflag_cll
3169  return
3170  end if
3171  if (rmax.gt.rmax_cll) then
3172  call seterrflag_cll(-10)
3173  call errout_cll('Eten_cll','argument rmax larger than rmax_cll',eflag,.true.)
3174  write(nerrout_cll,*) 'rmax =',rmax
3175  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3176  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3177  call propagateerrflag_cll
3178  return
3179  end if
3180 
3181  call eten_list_checked_cll(te,teuv,momvec,mominv,masses2,rmax,teerr)
3182 
3183  end subroutine eten_list_cll
3184 
3185 
3186  subroutine eten_list_checked_cll(TE,TEuv,MomVec,MomInv,masses2,rmax,TEerr)
3187 
3188  integer, intent(in) :: rmax
3189  double complex, intent(in) :: MomVec(0:3,4), MomInv(10), masses2(0:4)
3190  double complex, intent(out) :: TE(RtS(rmax)), TEuv(RtS(rmax))
3191  double precision, intent(out), optional :: TEerr(0:rmax)
3192  double complex :: TE2(RtS(rmax)), TEuv2(RtS(rmax))
3193  double complex :: CE(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3194  double complex :: CEuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3195  double precision :: CEerr(0:rmax), TEerr_aux(0:rmax), TEerr_aux2(0:rmax)
3196  double complex :: args(31)
3197  double precision :: TEdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TEacc(0:rmax)
3198  integer :: r,i
3199  logical :: eflag
3200 
3201  ! set ID of master call
3202  args(1:4) = momvec(0:,1)
3203  args(5:8) = momvec(0:,2)
3204  args(9:12) = momvec(0:,3)
3205  args(13:16) = momvec(0:,4)
3206  args(17:26) = mominv
3207  args(27:31) = masses2
3208  call setmasterfname_cll('Eten_cll')
3209  call setmastern_cll(5)
3210  call setmasterr_cll(rmax)
3211  call setmasterargs_cll(31,args)
3212 
3213  call settencache_cll(tenred_cll-1)
3214 
3215  if (mode_cll.eq.3) then
3216  ! calculate tensor with coefficients from COLI
3217  mode_cll = 1
3218  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3219  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3220  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3221  call calctensore_list(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3222 
3223  ! calculate tensor with coefficients from DD
3224  mode_cll = 2
3225  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3226  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3227  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3228  call calctensore_list(te2,teuv2,teerr_aux2,ce,ceuv,ceerr,momvec,rmax)
3229 
3230  ! comparison --> take better result
3231  mode_cll = 3
3232  do r=0,rmax
3233  norm_coli=0d0
3234  norm_dd=0d0
3235  do i=rts(r-1)+1,rts(r)
3236  norm_coli = max(norm_coli,abs(te(i)))
3237  norm_dd = max(norm_dd,abs(te2(i)))
3238  end do
3239  if (norm_coli.eq.0d0) then
3240  norm_coli = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3241  if(norm_coli.ne.0d0) then
3242  norm_coli=1d0/norm_coli**(3-real(r)/2)
3243  else
3244  norm_coli=1d0/muir2_cll**(3-real(r)/2)
3245  end if
3246  end if
3247  if (norm_dd.eq.0d0) then
3248  norm_dd = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3249  if(norm_dd.ne.0d0) then
3250  norm_dd=1d0/norm_dd**(3-real(r)/2)
3251  else
3252  norm_dd=1d0/muir2_cll**(3-real(r)/2)
3253  end if
3254  end if
3255  norm(r) = min(norm_coli,norm_dd)
3256  end do
3257 
3258  call checktensorslist_cll(te,te2,momvec,mominv,masses2,norm,5,rmax,tediff)
3259 
3260  if (teerr_aux(rmax).lt.teerr_aux2(rmax)) then
3261  if (present(teerr)) teerr = max(teerr_aux,tediff*norm)
3262  do r=0,rmax
3263  teacc(r) = max(teerr_aux(r)/norm(r),tediff(r))
3264  end do
3265  if (monitoring) pointscnteten_coli = pointscnteten_coli + 1
3266  else
3267  te = te2
3268  teuv = teuv2
3269  if (present(teerr)) teerr = max(teerr_aux2,tediff*norm)
3270  do r=0,rmax
3271  teacc(r) = max(teerr_aux2(r)/norm(r),tediff(r))
3272  end do
3273  if (monitoring) pointscnteten_dd = pointscnteten_dd + 1
3274  end if
3275 
3276  else
3277  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3278  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3279  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3280  call calctensore_list(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3281  if (present(teerr)) teerr = teerr_aux
3282  norm = 0d0
3283  do r=0,rmax
3284  do i=rts(r-1)+1,rts(r)
3285  norm(r) = max(norm(r),abs(te(i)))
3286  end do
3287  if (norm(r).eq.0d0) then
3288  norm(r) = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3289  if(norm(r).ne.0d0) then
3290  norm(r)=1d0/norm(r)**(3-real(r)/2)
3291  else
3292  norm(r)=1d0/muir2_cll**(3-real(r)/2)
3293  end if
3294  end if
3295  teacc(r) = teerr_aux(r)/norm(r)
3296  end do
3297 
3298  end if
3299 
3300  call propagateaccflag_cll(teacc,rmax)
3301  call propagateerrflag_cll
3302 
3303  if (monitoring) then
3304  pointscnteten_cll = pointscnteten_cll + 1
3305 
3306  if(maxval(teacc).gt.reqacc_cll) accpointscnteten_cll = accpointscnteten_cll + 1
3307 
3308  if(maxval(teacc).gt.critacc_cll) then
3309  critpointscnteten_cll = critpointscnteten_cll + 1
3310  if ( critpointscnteten_cll.le.noutcritpointsmax_cll(5) ) then
3311  call critpointsout_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3312  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3313  write(ncpout_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3314  write(ncpout_cll,*)
3315  endif
3316 #ifdef CritPoints2
3317  call critpointsout2_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3318  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3319  write(ncpout2_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3320  write(ncpout2_cll,*)
3321  endif
3322 #endif
3323  end if
3324  end if
3325  end if
3326 
3327  end subroutine eten_list_checked_cll
3328 
3329 
3330 
3331 
3332 
3333  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3334  ! subroutine Eten_args_cll(TE,TEuv,p1vec,p2vec,p3vec,p4vec,p10,p21,p32,p43, &
3335  ! p40,p20,p31,p42,p30,p41,m02,m12,m22,m32,m42,rmax,TEerr)
3336  !
3337  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3338 
3339  subroutine eten_args_cll(TE,TEuv,p1vec,p2vec,p3vec,p4vec,p10,p21,p32,p43, &
3340  p40,p20,p31,p42,p30,p41,m02,m12,m22,m32,m42,rmax,TEerr)
3341 
3342  integer, intent(in) :: rmax
3343  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
3344  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
3345  double complex, intent(in) :: m02,m12,m22,m32,m42
3346  double complex, intent(out) :: TE(0:rmax,0:rmax,0:rmax,0:rmax)
3347  double complex, intent(out) :: TEuv(0:rmax,0:rmax,0:rmax,0:rmax)
3348  double precision, intent(out), optional :: TEerr(0:rmax)
3349  double complex :: TE2(0:rmax,0:rmax,0:rmax,0:rmax), TEuv2(0:rmax,0:rmax,0:rmax,0:rmax)
3350  double complex :: MomVec(0:3,4), MomInv(10), masses2(0:4)
3351  double complex :: CE(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3352  double complex :: CEuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3353  double precision :: CEerr(0:rmax), TEerr_aux(0:rmax), TEerr_aux2(0:rmax)
3354  double complex :: args(31)
3355  double precision :: TEdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TEacc(0:rmax)
3356  integer :: r,n0,n1,n2,n3
3357  logical :: eflag
3358 
3359  if (5.gt.nmax_cll) then
3360  call seterrflag_cll(-10)
3361  call errout_cll('Eten_cll','Nmax_cll smaller 5',eflag,.true.)
3362  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3363  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 5'
3364  call propagateerrflag_cll
3365  return
3366  end if
3367  if (rmax.gt.rmax_cll) then
3368  call seterrflag_cll(-10)
3369  call errout_cll('Eten_cll','argument rmax larger than rmax_cll',eflag,.true.)
3370  write(nerrout_cll,*) 'rmax =',rmax
3371  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3372  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3373  call propagateerrflag_cll
3374  return
3375  end if
3376 
3377  momvec(0:,1) = p1vec
3378  momvec(0:,2) = p2vec
3379  momvec(0:,3) = p3vec
3380  momvec(0:,4) = p4vec
3381  mominv(1) = p10
3382  mominv(2) = p21
3383  mominv(3) = p32
3384  mominv(4) = p43
3385  mominv(5) = p40
3386  mominv(6) = p20
3387  mominv(7) = p31
3388  mominv(8) = p42
3389  mominv(9) = p30
3390  mominv(10) = p41
3391  masses2(0) = m02
3392  masses2(1) = m12
3393  masses2(2) = m22
3394  masses2(3) = m32
3395  masses2(4) = m42
3396 
3397  ! set ID of master call
3398  args(1:4) = momvec(0:,1)
3399  args(5:8) = momvec(0:,2)
3400  args(9:12) = momvec(0:,3)
3401  args(13:16) = momvec(0:,4)
3402  args(17:26) = mominv
3403  args(27:31) = masses2
3404  call setmasterfname_cll('Eten_cll')
3405  call setmastern_cll(5)
3406  call setmasterr_cll(rmax)
3407  call setmasterargs_cll(31,args)
3408 
3409  call settencache_cll(tenred_cll-1)
3410 
3411 
3412  if (mode_cll.eq.3) then
3413  ! calculate tensor with coefficients from COLI
3414  mode_cll = 1
3415  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3416  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3417  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3418  call calctensore(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3419 
3420  ! calculate tensor with coefficients from DD
3421  mode_cll = 2
3422  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3423  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3424  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3425  call calctensore(te2,teuv2,teerr_aux2,ce,ceuv,ceerr,momvec,rmax)
3426 
3427  ! comparison --> take better result
3428  mode_cll = 3
3429  do r=0,rmax
3430  norm_coli=0d0
3431  norm_dd=0d0
3432  do n0=0,r
3433  do n1=0,r-n0
3434  do n2=0,r-n0-n1
3435  n3=r-n0-n1-n2
3436  norm_coli = max(norm_coli,abs(te(n0,n1,n2,n3)))
3437  norm_dd = max(norm_dd,abs(te2(n0,n1,n2,n3)))
3438  end do
3439  end do
3440  end do
3441  if (norm_coli.eq.0d0) then
3442  norm_coli = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3443  if(norm_coli.ne.0d0) then
3444  norm_coli=1d0/norm_coli**(3-real(r)/2)
3445  else
3446  norm_coli=1d0/muir2_cll**(3-real(r)/2)
3447  end if
3448  end if
3449  if (norm_dd.eq.0d0) then
3450  norm_dd = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3451  if(norm_dd.ne.0d0) then
3452  norm_dd=1d0/norm_dd**(3-real(r)/2)
3453  else
3454  norm_dd=1d0/muir2_cll**(3-real(r)/2)
3455  end if
3456  end if
3457  norm(r) = min(norm_coli,norm_dd)
3458  end do
3459 
3460  call checktensors_cll(te,te2,momvec,mominv,masses2,norm,5,rmax,tediff)
3461 
3462  if (teerr_aux(rmax).lt.teerr_aux2(rmax)) then
3463  if (present(teerr)) teerr = max(teerr_aux,tediff*norm)
3464  do r=0,rmax
3465  teacc(r) = max(teerr_aux(r)/norm(r),tediff(r))
3466  end do
3467  if (monitoring) pointscnteten_coli = pointscnteten_coli + 1
3468  else
3469  te = te2
3470  teuv = teuv2
3471  if (present(teerr)) teerr = max(teerr_aux2,tediff*norm)
3472  do r=0,rmax
3473  teacc(r) = max(teerr_aux2(r)/norm(r),tediff(r))
3474  end do
3475  if (monitoring) pointscnteten_dd = pointscnteten_dd + 1
3476  end if
3477 
3478  else
3479  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3480  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3481  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3482  call calctensore(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3483  if (present(teerr)) teerr = teerr_aux
3484  norm = 0d0
3485  do r=0,rmax
3486  do n0=0,r
3487  do n1=0,r-n0
3488  do n2=0,r-n0-n1
3489  n3=r-n0-n1-n2
3490  norm(r) = max(norm(r),abs(te(n0,n1,n2,n3)))
3491  end do
3492  end do
3493  end do
3494  if (norm(r).eq.0d0) then
3495  norm(r) = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3496  if(norm(r).ne.0d0) then
3497  norm(r)=1d0/norm(r)**(3-real(r)/2)
3498  else
3499  norm(r)=1d0/muir2_cll**(3-real(r)/2)
3500  end if
3501  end if
3502  teacc(r) = teerr_aux(r)/norm(r)
3503  end do
3504 
3505  end if
3506 
3507  call propagateaccflag_cll(teacc,rmax)
3508  call propagateerrflag_cll
3509 
3510  if (monitoring) then
3511  pointscnteten_cll = pointscnteten_cll + 1
3512 
3513  if(maxval(teacc).gt.reqacc_cll) accpointscnteten_cll = accpointscnteten_cll + 1
3514 
3515  if(maxval(teacc).gt.critacc_cll) then
3516  critpointscnteten_cll = critpointscnteten_cll + 1
3517  if ( critpointscnteten_cll.le.noutcritpointsmax_cll(5) ) then
3518  call critpointsout_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3519  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3520  write(ncpout_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3521  write(ncpout_cll,*)
3522  endif
3523 #ifdef CritPoints2
3524  call critpointsout2_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3525  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3526  write(ncpout2_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3527  write(ncpout2_cll,*)
3528  endif
3529 #endif
3530  end if
3531  end if
3532  end if
3533 
3534  end subroutine eten_args_cll
3535 
3536 
3537 
3538 
3539 
3540  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3541  ! subroutine Eten_args_list_cll(TE,TEuv,p1vec,p2vec,p3vec,p4vec,p10,p21,p32,p43, &
3542  ! p40,p20,p31,p42,p30,p41,m02,m12,m22,m32,m42,rmax)
3543  !
3544  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3545 
3546  subroutine eten_args_list_cll(TE,TEuv,p1vec,p2vec,p3vec,p4vec,p10,p21,p32,p43, &
3547  p40,p20,p31,p42,p30,p41,m02,m12,m22,m32,m42,rmax,TEerr)
3548 
3549  integer, intent(in) :: rmax
3550  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
3551  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
3552  double complex, intent(in) :: m02,m12,m22,m32,m42
3553  double complex, intent(out) :: TE(RtS(rmax)), TEuv(RtS(rmax))
3554  double precision, intent(out), optional :: TEerr(0:rmax)
3555  double complex :: TE2(RtS(rmax)), TEuv2(RtS(rmax))
3556  double complex :: MomVec(0:3,4), MomInv(10), masses2(0:4)
3557  double complex :: CE(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3558  double complex :: CEuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3559  double precision :: CEerr(0:rmax), TEerr_aux(0:rmax), TEerr_aux2(0:rmax)
3560  double complex :: args(31)
3561  double precision :: TEdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TEacc(0:rmax)
3562  integer :: r,i
3563  logical :: eflag
3564 
3565  if (5.gt.nmax_cll) then
3566  call seterrflag_cll(-10)
3567  call errout_cll('Eten_cll','Nmax_cll smaller 5',eflag,.true.)
3568  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3569  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 5'
3570  call propagateerrflag_cll
3571  return
3572  end if
3573  if (rmax.gt.rmax_cll) then
3574  call seterrflag_cll(-10)
3575  call errout_cll('Eten_cll','argument rmax larger than rmax_cll',eflag,.true.)
3576  write(nerrout_cll,*) 'rmax =',rmax
3577  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3578  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3579  call propagateerrflag_cll
3580  return
3581  end if
3582 
3583  call eten_args_list_checked_cll(te,teuv,p1vec,p2vec,p3vec,p4vec, &
3584  p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
3585  m02,m12,m22,m32,m42,rmax,teerr)
3586 
3587  end subroutine eten_args_list_cll
3588 
3589 
3590  subroutine eten_args_list_checked_cll(TE,TEuv,p1vec,p2vec,p3vec,p4vec,p10,p21,p32,p43, &
3591  p40,p20,p31,p42,p30,p41,m02,m12,m22,m32,m42,rmax,TEerr)
3592 
3593  integer, intent(in) :: rmax
3594  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
3595  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
3596  double complex, intent(in) :: m02,m12,m22,m32,m42
3597  double complex, intent(out) :: TE(RtS(rmax)), TEuv(RtS(rmax))
3598  double precision, intent(out), optional :: TEerr(0:rmax)
3599  double complex :: TE2(RtS(rmax)), TEuv2(RtS(rmax))
3600  double complex :: MomVec(0:3,4), MomInv(10), masses2(0:4)
3601  double complex :: CE(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3602  double complex :: CEuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
3603  double precision :: CEerr(0:rmax), TEerr_aux(0:rmax), TEerr_aux2(0:rmax)
3604  double complex :: args(31)
3605  double precision :: TEdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TEacc(0:rmax)
3606  integer :: r,i
3607  logical :: eflag
3608 
3609  momvec(0:,1) = p1vec
3610  momvec(0:,2) = p2vec
3611  momvec(0:,3) = p3vec
3612  momvec(0:,4) = p4vec
3613  mominv(1) = p10
3614  mominv(2) = p21
3615  mominv(3) = p32
3616  mominv(4) = p43
3617  mominv(5) = p40
3618  mominv(6) = p20
3619  mominv(7) = p31
3620  mominv(8) = p42
3621  mominv(9) = p30
3622  mominv(10) = p41
3623  masses2(0) = m02
3624  masses2(1) = m12
3625  masses2(2) = m22
3626  masses2(3) = m32
3627  masses2(4) = m42
3628 
3629  ! set ID of master call
3630  args(1:4) = momvec(0:,1)
3631  args(5:8) = momvec(0:,2)
3632  args(9:12) = momvec(0:,3)
3633  args(13:16) = momvec(0:,4)
3634  args(17:26) = mominv
3635  args(27:31) = masses2
3636  call setmasterfname_cll('Eten_cll')
3637  call setmastern_cll(5)
3638  call setmasterr_cll(rmax)
3639  call setmasterargs_cll(31,args)
3640 
3641  call settencache_cll(tenred_cll-1)
3642 
3643 
3644  if (mode_cll.eq.3) then
3645  ! calculate tensor with coefficients from COLI
3646  mode_cll = 1
3647  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3648  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3649  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3650  call calctensore(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3651 
3652  ! calculate tensor with coefficients from DD
3653  mode_cll = 2
3654  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3655  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3656  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3657  call calctensore(te2,teuv2,teerr_aux2,ce,ceuv,ceerr,momvec,rmax)
3658 
3659  ! comparison --> take better result
3660  mode_cll = 3
3661  do r=0,rmax
3662  norm_coli=0d0
3663  norm_dd=0d0
3664  do i=rts(r-1)+1,rts(r)
3665  norm_coli = max(norm_coli,abs(te(i)))
3666  norm_dd = max(norm_dd,abs(te2(i)))
3667  end do
3668  if (norm_coli.eq.0d0) then
3669  norm_coli = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3670  if(norm_coli.ne.0d0) then
3671  norm_coli=1d0/norm_coli**(3-real(r)/2)
3672  else
3673  norm_coli=1d0/muir2_cll**(3-real(r)/2)
3674  end if
3675  end if
3676  if (norm_dd.eq.0d0) then
3677  norm_dd = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3678  if(norm_dd.ne.0d0) then
3679  norm_dd=1d0/norm_dd**(3-real(r)/2)
3680  else
3681  norm_dd=1d0/muir2_cll**(3-real(r)/2)
3682  end if
3683  end if
3684  norm(r) = min(norm_coli,norm_dd)
3685  end do
3686 
3687  call checktensorslist_cll(te,te2,momvec,mominv,masses2,norm,5,rmax,tediff)
3688 
3689  if (teerr_aux(rmax).lt.teerr_aux2(rmax)) then
3690  if (present(teerr)) teerr = max(teerr_aux,tediff*norm)
3691  do r=0,rmax
3692  teacc(r) = max(teerr_aux(r)/norm(r),tediff(r))
3693  end do
3694  if (monitoring) pointscnteten_coli = pointscnteten_coli + 1
3695  else
3696  te = te2
3697  teuv = teuv2
3698  if (present(teerr)) teerr = max(teerr_aux2,tediff*norm)
3699  do r=0,rmax
3700  teacc(r) = max(teerr_aux2(r)/norm(r),tediff(r))
3701  end do
3702  if (monitoring) pointscnteten_dd = pointscnteten_dd + 1
3703  end if
3704 
3705  else
3706  call e_main_cll(ce,ceuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3707  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),masses2(0), &
3708  masses2(1),masses2(2),masses2(3),masses2(4),rmax,eerr2=ceerr,id_in=0)
3709  call calctensore_list(te,teuv,teerr_aux,ce,ceuv,ceerr,momvec,rmax)
3710  if (present(teerr)) teerr = teerr_aux
3711  norm = 0d0
3712  do r=0,rmax
3713  do i=rts(r-1)+1,rts(r)
3714  norm(r) = max(norm(r),abs(te(i)))
3715  end do
3716  if (norm(r).eq.0d0) then
3717  norm(r) = max(maxval(abs(mominv(1:10))),maxval(abs(masses2(0:4))))
3718  if(norm(r).ne.0d0) then
3719  norm(r)=1d0/norm(r)**(3-real(r)/2)
3720  else
3721  norm(r)=1d0/muir2_cll**(3-real(r)/2)
3722  end if
3723  end if
3724  teacc(r) = teerr_aux(r)/norm(r)
3725  end do
3726 
3727  end if
3728 
3729  call propagateaccflag_cll(teacc,rmax)
3730  call propagateerrflag_cll
3731 
3732  if (monitoring) then
3733  pointscnteten_cll = pointscnteten_cll + 1
3734 
3735  if(maxval(teacc).gt.reqacc_cll) accpointscnteten_cll = accpointscnteten_cll + 1
3736 
3737  if(maxval(teacc).gt.critacc_cll) then
3738  critpointscnteten_cll = critpointscnteten_cll + 1
3739  if ( critpointscnteten_cll.le.noutcritpointsmax_cll(5) ) then
3740  call critpointsout_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3741  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3742  write(ncpout_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3743  write(ncpout_cll,*)
3744  endif
3745 #ifdef CritPoints2
3746  call critpointsout2_cll('TEten_cll',0,maxval(teacc),critpointscnteten_cll)
3747  if( critpointscnteten_cll.eq.noutcritpointsmax_cll(5)) then
3748  write(ncpout2_cll,*) ' Further output of Critical Points for TEten_cll suppressed'
3749  write(ncpout2_cll,*)
3750  endif
3751 #endif
3752  end if
3753  end if
3754  end if
3755 
3756  end subroutine eten_args_list_checked_cll
3757 
3758 
3759 
3760 
3761 
3762  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3763  ! subroutine Ften_main_cll(TF,TFuv,MomVec,MomInv,masses2,rmax,TFerr)
3764  !
3765  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3766 
3767  subroutine ften_main_cll(TF,TFuv,MomVec,MomInv,masses2,rmax,TFerr)
3768 
3769  integer, intent(in) :: rmax
3770  double complex, intent(in) :: MomVec(0:3,5), MomInv(15), masses2(0:5)
3771  double complex, intent(out) :: TF(0:rmax,0:rmax,0:rmax,0:rmax)
3772  double complex, intent(out) :: TFuv(0:rmax,0:rmax,0:rmax,0:rmax)
3773  double precision, intent(out), optional :: TFerr(0:rmax)
3774  double complex :: TF2(0:rmax,0:rmax,0:rmax,0:rmax), TFuv2(0:rmax,0:rmax,0:rmax,0:rmax)
3775  double complex :: CF(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3776  double complex :: CFuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
3777  double precision :: CFerr(0:rmax), TFerr_aux(0:rmax), TFerr_aux2(0:rmax)
3778  double complex :: args(41)
3779  double precision :: TFdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TFacc(0:rmax)
3780  integer :: r,n0,n1,n2,n3
3781  logical :: eflag
3782 
3783  if (6.gt.nmax_cll) then
3784  call seterrflag_cll(-10)
3785  call errout_cll('Ften_cll','Nmax_cll smaller 6',eflag,.true.)
3786  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
3787  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 6'
3788  call propagateerrflag_cll
3789  return
3790  end if
3791  if (rmax.gt.rmax_cll) then
3792  call seterrflag_cll(-10)
3793  call errout_cll('Ften_cll','argument rmax larger than rmax_cll',eflag,.true.)
3794  write(nerrout_cll,*) 'rmax =',rmax
3795  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
3796  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
3797  call propagateerrflag_cll
3798  return
3799  end if
3800 
3801  ! set ID of master call
3802  args(1:4) = momvec(0:,1)
3803  args(5:8) = momvec(0:,2)
3804  args(9:12) = momvec(0:,3)
3805  args(13:16) = momvec(0:,4)
3806  args(17:20) = momvec(0:,5)
3807  args(21:35) = mominv
3808  args(36:41) = masses2(0:)
3809  call setmasterfname_cll('Ften_cll')
3810  call setmastern_cll(6)
3811  call setmasterr_cll(rmax)
3812  call setmasterargs_cll(41,args)
3813 
3814  call settencache_cll(tenred_cll-1)
3815 
3816 
3817  if (tenred_cll.le.6) then
3818 
3819  if (mode_cll.gt.1) call f_dd_dummy(rmax)
3820 
3821  if (mode_cll.eq.3) then
3822  ! calculate tensor with coefficients from COLI
3823  mode_cll = 1
3824  call calctensorfr(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
3825 
3826  ! calculate tensor with coefficients from DD
3827  mode_cll = 2
3828  call calctensorfr(tf2,tfuv2,tferr_aux2,momvec,mominv,masses2,rmax)
3829 
3830  ! comparison --> take better result
3831  mode_cll = 3
3832  do r=0,rmax
3833  norm_coli=0d0
3834  norm_dd=0d0
3835  do n0=0,r
3836  do n1=0,r-n0
3837  do n2=0,r-n0-n1
3838  n3=r-n0-n1-n2
3839  norm_coli = max(norm_coli,abs(tf(n0,n1,n2,n3)))
3840  norm_dd = max(norm_dd,abs(tf2(n0,n1,n2,n3)))
3841  end do
3842  end do
3843  end do
3844  if (norm_coli.eq.0d0) then
3845  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
3846  if(norm_coli.ne.0d0) then
3847  norm_coli=1d0/norm_coli**(4-real(r)/2)
3848  else
3849  norm_coli=1d0/muir2_cll**(4-real(r)/2)
3850  end if
3851  end if
3852  if (norm_dd.eq.0d0) then
3853  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
3854  if(norm_dd.ne.0d0) then
3855  norm_dd=1d0/norm_dd**(4-real(r)/2)
3856  else
3857  norm_dd=1d0/muir2_cll**(4-real(r)/2)
3858  end if
3859  end if
3860  norm(r) = min(norm_coli,norm_dd)
3861  end do
3862 
3863  call checktensors_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
3864 
3865  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
3866  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
3867  do r=0,rmax
3868  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
3869  end do
3870  if (monitoring) pointscntften_coli = pointscntften_coli + 1
3871  else
3872  tf = tf2
3873  tfuv = tfuv2
3874  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
3875  do r=0,rmax
3876  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
3877  end do
3878  if (monitoring) pointscntften_dd = pointscntften_dd + 1
3879  end if
3880 
3881  else
3882  call calctensorfr(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
3883  if (present(tferr)) tferr = tferr_aux
3884  norm = 0d0
3885  do r=0,rmax
3886  do n0=0,r
3887  do n1=0,r-n0
3888  do n2=0,r-n0-n1
3889  n3=r-n0-n1-n2
3890  norm(r) = max(norm(r),abs(tf(n0,n1,n2,n3)))
3891  end do
3892  end do
3893  end do
3894  if (norm(r).eq.0d0) then
3895  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
3896  if(norm(r).ne.0d0) then
3897  norm(r)=1d0/norm(r)**(4-real(r)/2)
3898  else
3899  norm(r)=1d0/muir2_cll**(4-real(r)/2)
3900  end if
3901  end if
3902  tfacc(r) = tferr_aux(r)/norm(r)
3903  end do
3904 
3905  end if
3906 
3907 
3908  else
3909 
3910  if (mode_cll.eq.3) then
3911  ! calculate tensor with coefficients from COLI
3912  mode_cll = 1
3913  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3914  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
3915  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
3916  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
3917  call calctensorf(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
3918 
3919  ! calculate tensor with coefficients from DD
3920  mode_cll = 2
3921  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3922  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
3923  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
3924  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
3925  call calctensorf(tf2,tfuv2,tferr_aux2,cf,cfuv,cferr,momvec,rmax)
3926 
3927  ! comparison --> take better result
3928  mode_cll = 3
3929  do r=0,rmax
3930  norm_coli=0d0
3931  norm_dd=0d0
3932  do n0=0,r
3933  do n1=0,r-n0
3934  do n2=0,r-n0-n1
3935  n3=r-n0-n1-n2
3936  norm_coli = max(norm_coli,abs(tf(n0,n1,n2,n3)))
3937  norm_dd = max(norm_dd,abs(tf2(n0,n1,n2,n3)))
3938  end do
3939  end do
3940  end do
3941  if (norm_coli.eq.0d0) then
3942  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
3943  if(norm_coli.ne.0d0) then
3944  norm_coli=1d0/norm_coli**(4-real(r)/2)
3945  else
3946  norm_coli=1d0/muir2_cll**(4-real(r)/2)
3947  end if
3948  end if
3949  if (norm_dd.eq.0d0) then
3950  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
3951  if(norm_dd.ne.0d0) then
3952  norm_dd=1d0/norm_dd**(4-real(r)/2)
3953  else
3954  norm_dd=1d0/muir2_cll**(4-real(r)/2)
3955  end if
3956  end if
3957  norm(r) = min(norm_coli,norm_dd)
3958  end do
3959 
3960  call checktensors_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
3961 
3962  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
3963  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
3964  do r=0,rmax
3965  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
3966  end do
3967  if (monitoring) pointscntften_coli = pointscntften_coli + 1
3968  else
3969  tf = tf2
3970  tfuv = tfuv2
3971  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
3972  do r=0,rmax
3973  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
3974  end do
3975  if (monitoring) pointscntften_dd = pointscntften_dd + 1
3976  end if
3977 
3978  else
3979  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
3980  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
3981  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
3982  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
3983  call calctensorf(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
3984  if (present(tferr)) tferr = tferr_aux
3985  norm = 0d0
3986  do r=0,rmax
3987  do n0=0,r
3988  do n1=0,r-n0
3989  do n2=0,r-n0-n1
3990  n3=r-n0-n1-n2
3991  norm(r) = max(norm(r),abs(tf(n0,n1,n2,n3)))
3992  end do
3993  end do
3994  end do
3995  if (norm(r).eq.0d0) then
3996  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
3997  if(norm(r).ne.0d0) then
3998  norm(r)=1d0/norm(r)**(4-real(r)/2)
3999  else
4000  norm(r)=1d0/muir2_cll**(4-real(r)/2)
4001  end if
4002  end if
4003  tfacc(r) = tferr_aux(r)/norm(r)
4004  end do
4005 
4006  end if
4007 
4008  end if
4009 
4010  call propagateaccflag_cll(tfacc,rmax)
4011  call propagateerrflag_cll
4012 
4013  if (monitoring) then
4014  pointscntften_cll = pointscntften_cll + 1
4015 
4016  if(maxval(tfacc).gt.reqacc_cll) accpointscntften_cll = accpointscntften_cll + 1
4017 
4018  if(maxval(tfacc).gt.critacc_cll) then
4019  critpointscntften_cll = critpointscntften_cll + 1
4020  if ( critpointscntften_cll.le.noutcritpointsmax_cll(6) ) then
4021  call critpointsout_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4022  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4023  write(ncpout_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4024  write(ncpout_cll,*)
4025  endif
4026 #ifdef CritPoints2
4027  call critpointsout2_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4028  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4029  write(ncpout2_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4030  write(ncpout2_cll,*)
4031  endif
4032 #endif
4033  end if
4034  end if
4035  end if
4036 
4037  end subroutine ften_main_cll
4038 
4039 
4040 
4041 
4042 
4043  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4044  ! subroutine Ften_list_cll(TF,TFuv,MomVec,MomInv,masses2,rmax,TFerr)
4045  !
4046  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4047 
4048  subroutine ften_list_cll(TF,TFuv,MomVec,MomInv,masses2,rmax,TFerr)
4049 
4050  integer, intent(in) :: rmax
4051  double complex, intent(in) :: MomVec(0:3,5), MomInv(15), masses2(0:5)
4052  double complex, intent(out) :: TF(:), TFuv(:)
4053  double precision, intent(out), optional :: TFerr(0:rmax)
4054  logical :: eflag
4055 
4056  if (6.gt.nmax_cll) then
4057  call seterrflag_cll(-10)
4058  call errout_cll('Ften_cll','Nmax_cll smaller 6',eflag,.true.)
4059  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
4060  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 6'
4061  call propagateerrflag_cll
4062  return
4063  end if
4064  if (rmax.gt.rmax_cll) then
4065  call seterrflag_cll(-10)
4066  call errout_cll('Ften_cll','argument rmax larger than rmax_cll',eflag,.true.)
4067  write(nerrout_cll,*) 'rmax =',rmax
4068  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
4069  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
4070  call propagateerrflag_cll
4071  return
4072  end if
4073 
4074  call ften_list_checked_cll(tf,tfuv,momvec,mominv,masses2,rmax,tferr)
4075 
4076  end subroutine ften_list_cll
4077 
4078 
4079  subroutine ften_list_checked_cll(TF,TFuv,MomVec,MomInv,masses2,rmax,TFerr)
4080 
4081  integer, intent(in) :: rmax
4082  double complex, intent(in) :: MomVec(0:3,5), MomInv(15), masses2(0:5)
4083  double complex, intent(out) :: TF(RtS(rmax)), TFuv(RtS(rmax))
4084  double precision, intent(out), optional :: TFerr(0:rmax)
4085  double complex :: TF2(RtS(rmax)), TFuv2(RtS(rmax))
4086  double complex :: CF(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4087  double complex :: CFuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4088  double precision :: CFerr(0:rmax), TFerr_aux(0:rmax), TFerr_aux2(0:rmax)
4089  double complex :: args(41)
4090  double precision :: TFdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TFacc(0:rmax)
4091  integer :: r,i
4092  logical :: eflag
4093 
4094  ! set ID of master call
4095  args(1:4) = momvec(0:,1)
4096  args(5:8) = momvec(0:,2)
4097  args(9:12) = momvec(0:,3)
4098  args(13:16) = momvec(0:,4)
4099  args(17:20) = momvec(0:,5)
4100  args(21:35) = mominv
4101  args(36:41) = masses2(0:)
4102  call setmasterfname_cll('Ften_cll')
4103  call setmastern_cll(6)
4104  call setmasterr_cll(rmax)
4105  call setmasterargs_cll(41,args)
4106 
4107  call settencache_cll(tenred_cll-1)
4108 
4109  if (tenred_cll.le.6) then
4110 
4111  if (mode_cll.gt.1) call f_dd_dummy(rmax)
4112 
4113  if (mode_cll.eq.3) then
4114  ! calculate tensor with coefficients from COLI
4115  mode_cll = 1
4116  call calctensorfr_list(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
4117 
4118  ! calculate tensor with coefficients from DD
4119  mode_cll = 2
4120  call calctensorfr_list(tf2,tfuv2,tferr_aux2,momvec,mominv,masses2,rmax)
4121 
4122  ! comparison --> take better result
4123  mode_cll = 3
4124  do r=0,rmax
4125  norm_coli=0d0
4126  norm_dd=0d0
4127  do i=rts(r-1)+1,rts(r)
4128  norm_coli = max(norm_coli,abs(tf(i)))
4129  norm_dd = max(norm_dd,abs(tf2(i)))
4130  end do
4131  if (norm_coli.eq.0d0) then
4132  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4133  if(norm_coli.ne.0d0) then
4134  norm_coli=1d0/norm_coli**(4-real(r)/2)
4135  else
4136  norm_coli=1d0/muir2_cll**(4-real(r)/2)
4137  end if
4138  end if
4139  if (norm_dd.eq.0d0) then
4140  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4141  if(norm_dd.ne.0d0) then
4142  norm_dd=1d0/norm_dd**(4-real(r)/2)
4143  else
4144  norm_dd=1d0/muir2_cll**(4-real(r)/2)
4145  end if
4146  end if
4147  norm(r) = min(norm_coli,norm_dd)
4148  end do
4149 
4150  call checktensorslist_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
4151 
4152  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
4153  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
4154  do r=0,rmax
4155  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
4156  end do
4157  if (monitoring) pointscntften_coli = pointscntften_coli + 1
4158  else
4159  tf = tf2
4160  tfuv = tfuv2
4161  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
4162  do r=0,rmax
4163  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
4164  end do
4165  if (monitoring) pointscntften_dd = pointscntften_dd + 1
4166  end if
4167 
4168  else
4169  call calctensorfr_list(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
4170  if (present(tferr)) tferr = tferr_aux
4171  norm = 0d0
4172  do r=0,rmax
4173  do i=rts(r-1)+1,rts(r)
4174  norm(r) = max(norm(r),abs(tf(i)))
4175  end do
4176  if (norm(r).eq.0d0) then
4177  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4178  if(norm(r).ne.0d0) then
4179  norm(r)=1d0/norm(r)**(4-real(r)/2)
4180  else
4181  norm(r)=1d0/muir2_cll**(4-real(r)/2)
4182  end if
4183  end if
4184  tfacc(r) = tferr_aux(r)/norm(r)
4185  end do
4186 
4187  end if
4188 
4189  else
4190 
4191 
4192  if (mode_cll.eq.3) then
4193  ! calculate tensor with coefficients from COLI
4194  mode_cll = 1
4195  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4196  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4197  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4198  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4199  call calctensorf_list(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
4200 
4201  ! calculate tensor with coefficients from DD
4202  mode_cll = 2
4203  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4204  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4205  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4206  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4207  call calctensorf_list(tf2,tfuv2,tferr_aux2,cf,cfuv,cferr,momvec,rmax)
4208 
4209  ! comparison --> take better result
4210  mode_cll = 3
4211  do r=0,rmax
4212  norm_coli=0d0
4213  norm_dd=0d0
4214  do i=rts(r-1)+1,rts(r)
4215  norm_coli = max(norm_coli,abs(tf(i)))
4216  norm_dd = max(norm_dd,abs(tf2(i)))
4217  end do
4218  if (norm_coli.eq.0d0) then
4219  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4220  if(norm_coli.ne.0d0) then
4221  norm_coli=1d0/norm_coli**(4-real(r)/2)
4222  else
4223  norm_coli=1d0/muir2_cll**(4-real(r)/2)
4224  end if
4225  end if
4226  if (norm_dd.eq.0d0) then
4227  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4228  if(norm_dd.ne.0d0) then
4229  norm_dd=1d0/norm_dd**(4-real(r)/2)
4230  else
4231  norm_dd=1d0/muir2_cll**(4-real(r)/2)
4232  end if
4233  end if
4234  norm(r) = min(norm_coli,norm_dd)
4235  end do
4236 
4237  call checktensorslist_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
4238 
4239  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
4240  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
4241  do r=0,rmax
4242  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
4243  end do
4244  if (monitoring) pointscntften_coli = pointscntften_coli + 1
4245  else
4246  tf = tf2
4247  tfuv = tfuv2
4248  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
4249  do r=0,rmax
4250  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
4251  end do
4252  if (monitoring) pointscntften_dd = pointscntften_dd + 1
4253  end if
4254 
4255  else
4256  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4257  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4258  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4259  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4260  call calctensorf_list(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
4261  if (present(tferr)) tferr = tferr_aux
4262  norm = 0d0
4263  do r=0,rmax
4264  do i=rts(r-1)+1,rts(r)
4265  norm(r) = max(norm(r),abs(tf(i)))
4266  end do
4267  if (norm(r).eq.0d0) then
4268  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4269  if(norm(r).ne.0d0) then
4270  norm(r)=1d0/norm(r)**(4-real(r)/2)
4271  else
4272  norm(r)=1d0/muir2_cll**(4-real(r)/2)
4273  end if
4274  end if
4275  tfacc(r) = tferr_aux(r)/norm(r)
4276  end do
4277 
4278  end if
4279 
4280  end if
4281 
4282  call propagateaccflag_cll(tfacc,rmax)
4283  call propagateerrflag_cll
4284 
4285  if (monitoring) then
4286  pointscntften_cll = pointscntften_cll + 1
4287 
4288  if(maxval(tfacc).gt.reqacc_cll) accpointscntften_cll = accpointscntften_cll + 1
4289 
4290  if(maxval(tfacc).gt.critacc_cll) then
4291  critpointscntften_cll = critpointscntften_cll + 1
4292  if ( critpointscntften_cll.le.noutcritpointsmax_cll(6) ) then
4293  call critpointsout_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4294  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4295  write(ncpout_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4296  write(ncpout_cll,*)
4297  endif
4298 #ifdef CritPoints2
4299  call critpointsout2_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4300  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4301  write(ncpout2_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4302  write(ncpout2_cll,*)
4303  endif
4304 #endif
4305  end if
4306  end if
4307  end if
4308 
4309  end subroutine ften_list_checked_cll
4310 
4311 
4312 
4313 
4314 
4315  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4316  ! subroutine Ften_args_cll(TF,TFuv,p1vec,p2vec,p3vec,p4vec,p5vec, &
4317  ! p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
4318  ! p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,TFerr)
4319  !
4320  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4321 
4322  subroutine ften_args_cll(TF,TFuv,p1vec,p2vec,p3vec,p4vec,p5vec, &
4323  p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
4324  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,TFerr)
4325  integer, intent(in) :: rmax
4326  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
4327  double complex, intent(in) :: p5vec(0:3)
4328  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
4329  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
4330  double complex, intent(out) :: TF(0:rmax,0:rmax,0:rmax,0:rmax)
4331  double complex, intent(out) :: TFuv(0:rmax,0:rmax,0:rmax,0:rmax)
4332  double precision, intent(out), optional :: TFerr(0:rmax)
4333  double complex :: TF2(0:rmax,0:rmax,0:rmax,0:rmax), TFuv2(0:rmax,0:rmax,0:rmax,0:rmax)
4334  double complex :: MomVec(0:3,5), MomInv(15), masses2(0:5)
4335  double complex :: CF(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4336  double complex :: CFuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4337  double precision :: CFerr(0:rmax), TFerr_aux(0:rmax), TFerr_aux2(0:rmax)
4338  double complex :: args(41)
4339  double precision :: TFdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TFacc(0:rmax)
4340  integer :: r,n0,n1,n2,n3
4341  logical :: eflag
4342 
4343  if (6.gt.nmax_cll) then
4344  call seterrflag_cll(-10)
4345  call errout_cll('Ften_cll','Nmax_cll smaller 6',eflag,.true.)
4346  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
4347  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 6'
4348  call propagateerrflag_cll
4349  return
4350  end if
4351  if (rmax.gt.rmax_cll) then
4352  call seterrflag_cll(-10)
4353  call errout_cll('Ften_cll','argument rmax larger than rmax_cll',eflag,.true.)
4354  write(nerrout_cll,*) 'rmax =',rmax
4355  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
4356  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
4357  call propagateerrflag_cll
4358  return
4359  end if
4360 
4361  momvec(0:,1) = p1vec
4362  momvec(0:,2) = p2vec
4363  momvec(0:,3) = p3vec
4364  momvec(0:,4) = p4vec
4365  momvec(0:,5) = p5vec
4366  mominv(1) = p10
4367  mominv(2) = p21
4368  mominv(3) = p32
4369  mominv(4) = p43
4370  mominv(5) = p54
4371  mominv(6) = p50
4372  mominv(7) = p20
4373  mominv(8) = p31
4374  mominv(9) = p42
4375  mominv(10) = p53
4376  mominv(11) = p40
4377  mominv(12) = p51
4378  mominv(13) = p30
4379  mominv(14) = p41
4380  mominv(15) = p52
4381  masses2(0) = m02
4382  masses2(1) = m12
4383  masses2(2) = m22
4384  masses2(3) = m32
4385  masses2(4) = m42
4386  masses2(5) = m52
4387 
4388  ! set ID of master call
4389  args(1:4) = momvec(0:,1)
4390  args(5:8) = momvec(0:,2)
4391  args(9:12) = momvec(0:,3)
4392  args(13:16) = momvec(0:,4)
4393  args(17:20) = momvec(0:,5)
4394  args(21:35) = mominv
4395  args(36:41) = masses2(0:)
4396  call setmasterfname_cll('Ften_cll')
4397  call setmastern_cll(6)
4398  call setmasterr_cll(rmax)
4399  call setmasterargs_cll(41,args)
4400 
4401  call settencache_cll(tenred_cll-1)
4402 
4403  if (tenred_cll.le.6) then
4404 
4405  if (mode_cll.gt.1) call f_dd_dummy(rmax)
4406 
4407  if (mode_cll.eq.3) then
4408  ! calculate tensor with coefficients from COLI
4409  mode_cll = 1
4410  call calctensorfr(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
4411 
4412  ! calculate tensor with coefficients from DD
4413  mode_cll = 2
4414  call calctensorfr(tf2,tfuv2,tferr_aux2,momvec,mominv,masses2,rmax)
4415 
4416  ! comparison --> take better result
4417  mode_cll = 3
4418  do r=0,rmax
4419  norm_coli=0d0
4420  norm_dd=0d0
4421  do n0=0,r
4422  do n1=0,r-n0
4423  do n2=0,r-n0-n1
4424  n3=r-n0-n1-n2
4425  norm_coli = max(norm_coli,abs(tf(n0,n1,n2,n3)))
4426  norm_dd = max(norm_dd,abs(tf2(n0,n1,n2,n3)))
4427  end do
4428  end do
4429  end do
4430  if (norm_coli.eq.0d0) then
4431  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4432  if(norm_coli.ne.0d0) then
4433  norm_coli=1d0/norm_coli**(4-real(r)/2)
4434  else
4435  norm_coli=1d0/muir2_cll**(4-real(r)/2)
4436  end if
4437  end if
4438  if (norm_dd.eq.0d0) then
4439  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4440  if(norm_dd.ne.0d0) then
4441  norm_dd=1d0/norm_dd**(4-real(r)/2)
4442  else
4443  norm_dd=1d0/muir2_cll**(4-real(r)/2)
4444  end if
4445  end if
4446  norm(r) = min(norm_coli,norm_dd)
4447  end do
4448 
4449  call checktensors_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
4450 
4451  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
4452  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
4453  do r=0,rmax
4454  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
4455  end do
4456  if (monitoring) pointscntften_coli = pointscntften_coli + 1
4457  else
4458  tf = tf2
4459  tfuv = tfuv2
4460  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
4461  do r=0,rmax
4462  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
4463  end do
4464  if (monitoring) pointscntften_dd = pointscntften_dd + 1
4465  end if
4466 
4467  else
4468  call calctensorfr(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
4469  if (present(tferr)) tferr = tferr_aux
4470  norm = 0d0
4471  do r=0,rmax
4472  do n0=0,r
4473  do n1=0,r-n0
4474  do n2=0,r-n0-n1
4475  n3=r-n0-n1-n2
4476  norm(r) = max(norm(r),abs(tf(n0,n1,n2,n3)))
4477  end do
4478  end do
4479  end do
4480  if (norm(r).eq.0d0) then
4481  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4482  if(norm(r).ne.0d0) then
4483  norm(r)=1d0/norm(r)**(4-real(r)/2)
4484  else
4485  norm(r)=1d0/muir2_cll**(4-real(r)/2)
4486  end if
4487  end if
4488  tfacc(r) = tferr_aux(r)/norm(r)
4489  end do
4490 
4491  end if
4492 
4493  else
4494 
4495  if (mode_cll.eq.3) then
4496  ! calculate tensor with coefficients from COLI
4497  mode_cll = 1
4498  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4499  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4500  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4501  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4502  call calctensorf(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
4503 
4504  ! calculate tensor with coefficients from DD
4505  mode_cll = 2
4506  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4507  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4508  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4509  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4510  call calctensorf(tf2,tfuv2,tferr_aux2,cf,cfuv,cferr,momvec,rmax)
4511 
4512  ! comparison --> take better result
4513  mode_cll = 3
4514  do r=0,rmax
4515  norm_coli=0d0
4516  norm_dd=0d0
4517  do n0=0,r
4518  do n1=0,r-n0
4519  do n2=0,r-n0-n1
4520  n3=r-n0-n1-n2
4521  norm_coli = max(norm_coli,abs(tf(n0,n1,n2,n3)))
4522  norm_dd = max(norm_dd,abs(tf2(n0,n1,n2,n3)))
4523  end do
4524  end do
4525  end do
4526  if (norm_coli.eq.0d0) then
4527  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4528  if(norm_coli.ne.0d0) then
4529  norm_coli=1d0/norm_coli**(4-real(r)/2)
4530  else
4531  norm_coli=1d0/muir2_cll**(4-real(r)/2)
4532  end if
4533  end if
4534  if (norm_dd.eq.0d0) then
4535  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4536  if(norm_dd.ne.0d0) then
4537  norm_dd=1d0/norm_dd**(4-real(r)/2)
4538  else
4539  norm_dd=1d0/muir2_cll**(4-real(r)/2)
4540  end if
4541  end if
4542  norm(r) = min(norm_coli,norm_dd)
4543  end do
4544 
4545  call checktensors_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
4546 
4547  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
4548  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
4549  do r=0,rmax
4550  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
4551  end do
4552  if (monitoring) pointscntften_coli = pointscntften_coli + 1
4553  else
4554  tf = tf2
4555  tfuv = tfuv2
4556  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
4557  do r=0,rmax
4558  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
4559  end do
4560  if (monitoring) pointscntften_dd = pointscntften_dd + 1
4561  end if
4562 
4563  else
4564  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4565  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4566  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4567  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4568  call calctensorf(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
4569  if (present(tferr)) tferr = tferr_aux
4570  norm = 0d0
4571  do r=0,rmax
4572  do n0=0,r
4573  do n1=0,r-n0
4574  do n2=0,r-n0-n1
4575  n3=r-n0-n1-n2
4576  norm(r) = max(norm(r),abs(tf(n0,n1,n2,n3)))
4577  end do
4578  end do
4579  end do
4580  if (norm(r).eq.0d0) then
4581  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4582  if(norm(r).ne.0d0) then
4583  norm(r)=1d0/norm(r)**(4-real(r)/2)
4584  else
4585  norm(r)=1d0/muir2_cll**(4-real(r)/2)
4586  end if
4587  end if
4588  tfacc(r) = tferr_aux(r)/norm(r)
4589  end do
4590 
4591  end if
4592 
4593  end if
4594 
4595  call propagateaccflag_cll(tfacc,rmax)
4596  call propagateerrflag_cll
4597 
4598  if (monitoring) then
4599  pointscntften_cll = pointscntften_cll + 1
4600 
4601  if(maxval(tfacc).gt.reqacc_cll) accpointscntften_cll = accpointscntften_cll + 1
4602 
4603  if(maxval(tfacc).gt.critacc_cll) then
4604  critpointscntften_cll = critpointscntften_cll + 1
4605  if ( critpointscntften_cll.le.noutcritpointsmax_cll(6) ) then
4606  call critpointsout_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4607  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4608  write(ncpout_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4609  write(ncpout_cll,*)
4610  endif
4611 #ifdef CritPoints2
4612  call critpointsout2_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4613  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4614  write(ncpout2_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4615  write(ncpout2_cll,*)
4616  endif
4617 #endif
4618  end if
4619  end if
4620  end if
4621 
4622  end subroutine ften_args_cll
4623 
4624 
4625 
4626 
4627 
4628  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4629  ! subroutine Ften_args_list_cll(TF,TFuv,p1vec,p2vec,p3vec,p4vec,p5vec, &
4630  ! p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
4631  ! p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,TFerr)
4632  !
4633  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4634 
4635  subroutine ften_args_list_cll(TF,TFuv,p1vec,p2vec,p3vec,p4vec,p5vec, &
4636  p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
4637  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,TFerr)
4638  integer, intent(in) :: rmax
4639  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
4640  double complex, intent(in) :: p5vec(0:3)
4641  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
4642  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
4643  double complex, intent(out) :: TF(:),TFuv(:)
4644  double precision, intent(out), optional :: TFerr(0:rmax)
4645  logical :: eflag
4646 
4647  if (6.gt.nmax_cll) then
4648  call seterrflag_cll(-10)
4649  call errout_cll('Ften_cll','Nmax_cll smaller 6',eflag,.true.)
4650  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
4651  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 6'
4652  call propagateerrflag_cll
4653  return
4654  end if
4655  if (rmax.gt.rmax_cll) then
4656  call seterrflag_cll(-10)
4657  call errout_cll('Ften_cll','argument rmax larger than rmax_cll',eflag,.true.)
4658  write(nerrout_cll,*) 'rmax =',rmax
4659  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
4660  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
4661  call propagateerrflag_cll
4662  return
4663  end if
4664 
4665  call ften_args_list_checked_cll(tf,tfuv,p1vec,p2vec,p3vec,p4vec,p5vec, &
4666  p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
4667  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,tferr)
4668 
4669  end subroutine ften_args_list_cll
4670 
4671 
4672  subroutine ften_args_list_checked_cll(TF,TFuv,p1vec,p2vec,p3vec,p4vec,p5vec, &
4673  p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
4674  p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,TFerr)
4675 
4676  integer, intent(in) :: rmax
4677  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
4678  double complex, intent(in) :: p5vec(0:3)
4679  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
4680  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
4681  double complex, intent(out) :: TF(RtS(rmax)),TFuv(RtS(rmax))
4682  double precision, intent(out), optional :: TFerr(0:rmax)
4683  double complex :: TF2(RtS(rmax)),TFuv2(RtS(rmax))
4684  double complex :: MomVec(0:3,5), MomInv(15), masses2(0:5)
4685  double complex :: CF(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4686  double complex :: CFuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4687  double precision :: CFerr(0:rmax), TFerr_aux(0:rmax), TFerr_aux2(0:rmax)
4688  double complex :: args(41)
4689  double precision :: TFdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TFacc(0:rmax)
4690  integer :: r,i
4691  logical :: eflag
4692 
4693  momvec(0:,1) = p1vec
4694  momvec(0:,2) = p2vec
4695  momvec(0:,3) = p3vec
4696  momvec(0:,4) = p4vec
4697  momvec(0:,5) = p5vec
4698  mominv(1) = p10
4699  mominv(2) = p21
4700  mominv(3) = p32
4701  mominv(4) = p43
4702  mominv(5) = p54
4703  mominv(6) = p50
4704  mominv(7) = p20
4705  mominv(8) = p31
4706  mominv(9) = p42
4707  mominv(10) = p53
4708  mominv(11) = p40
4709  mominv(12) = p51
4710  mominv(13) = p30
4711  mominv(14) = p41
4712  mominv(15) = p52
4713  masses2(0) = m02
4714  masses2(1) = m12
4715  masses2(2) = m22
4716  masses2(3) = m32
4717  masses2(4) = m42
4718  masses2(5) = m52
4719 
4720  ! set ID of master call
4721  args(1:4) = momvec(0:,1)
4722  args(5:8) = momvec(0:,2)
4723  args(9:12) = momvec(0:,3)
4724  args(13:16) = momvec(0:,4)
4725  args(17:20) = momvec(0:,5)
4726  args(21:35) = mominv
4727  args(36:41) = masses2(0:)
4728  call setmasterfname_cll('Ften_cll')
4729  call setmastern_cll(6)
4730  call setmasterr_cll(rmax)
4731  call setmasterargs_cll(41,args)
4732 
4733  call settencache_cll(tenred_cll-1)
4734 
4735  if (tenred_cll.le.6) then
4736 
4737  if (mode_cll.gt.1) call f_dd_dummy(rmax)
4738 
4739  if (mode_cll.eq.3) then
4740  ! calculate tensor with coefficients from COLI
4741  mode_cll = 1
4742  call calctensorfr_list(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
4743 
4744  ! calculate tensor with coefficients from DD
4745  mode_cll = 2
4746  call calctensorfr_list(tf2,tfuv2,tferr_aux2,momvec,mominv,masses2,rmax)
4747 
4748  ! comparison --> take better result
4749  mode_cll = 3
4750  do r=0,rmax
4751  norm_coli=0d0
4752  norm_dd=0d0
4753  do i=rts(r-1)+1,rts(r)
4754  norm_coli = max(norm_coli,abs(tf(i)))
4755  norm_dd = max(norm_dd,abs(tf2(i)))
4756  end do
4757  if (norm_coli.eq.0d0) then
4758  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4759  if(norm_coli.ne.0d0) then
4760  norm_coli=1d0/norm_coli**(4-real(r)/2)
4761  else
4762  norm_coli=1d0/muir2_cll**(4-real(r)/2)
4763  end if
4764  end if
4765  if (norm_dd.eq.0d0) then
4766  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4767  if(norm_dd.ne.0d0) then
4768  norm_dd=1d0/norm_dd**(4-real(r)/2)
4769  else
4770  norm_dd=1d0/muir2_cll**(4-real(r)/2)
4771  end if
4772  end if
4773  norm(r) = min(norm_coli,norm_dd)
4774  end do
4775 
4776  call checktensorslist_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
4777 
4778  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
4779  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
4780  do r=0,rmax
4781  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
4782  end do
4783  if (monitoring) pointscntften_coli = pointscntften_coli + 1
4784  else
4785  tf = tf2
4786  tfuv = tfuv2
4787  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
4788  do r=0,rmax
4789  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
4790  end do
4791  if (monitoring) pointscntften_dd = pointscntften_dd + 1
4792  end if
4793 
4794  else
4795  call calctensorfr_list(tf,tfuv,tferr_aux,momvec,mominv,masses2,rmax)
4796  if (present(tferr)) tferr = tferr_aux
4797  norm = 0d0
4798  do r=0,rmax
4799  do i=rts(r-1)+1,rts(r)
4800  norm(r) = max(norm(r),abs(tf(i)))
4801  end do
4802  if (norm(r).eq.0d0) then
4803  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4804  if(norm(r).ne.0d0) then
4805  norm(r)=1d0/norm(r)**(4-real(r)/2)
4806  else
4807  norm(r)=1d0/muir2_cll**(4-real(r)/2)
4808  end if
4809  end if
4810  tfacc(r) = tferr_aux(r)/norm(r)
4811  end do
4812 
4813  end if
4814 
4815  else
4816  if (mode_cll.eq.3) then
4817  ! calculate tensor with coefficients from COLI
4818  mode_cll = 1
4819  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4820  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4821  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4822  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4823  call calctensorf_list(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
4824 
4825  ! calculate tensor with coefficients from DD
4826  mode_cll = 2
4827  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4828  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4829  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4830  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4831  call calctensorf_list(tf2,tfuv2,tferr_aux2,cf,cfuv,cferr,momvec,rmax)
4832 
4833  ! comparison --> take better result
4834  mode_cll = 3
4835  do r=0,rmax
4836  norm_coli=0d0
4837  norm_dd=0d0
4838  do i=rts(r-1)+1,rts(r)
4839  norm_coli = max(norm_coli,abs(tf(i)))
4840  norm_dd = max(norm_dd,abs(tf2(i)))
4841  end do
4842  if (norm_coli.eq.0d0) then
4843  norm_coli = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4844  if(norm_coli.ne.0d0) then
4845  norm_coli=1d0/norm_coli**(4-real(r)/2)
4846  else
4847  norm_coli=1d0/muir2_cll**(4-real(r)/2)
4848  end if
4849  end if
4850  if (norm_dd.eq.0d0) then
4851  norm_dd = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4852  if(norm_dd.ne.0d0) then
4853  norm_dd=1d0/norm_dd**(4-real(r)/2)
4854  else
4855  norm_dd=1d0/muir2_cll**(4-real(r)/2)
4856  end if
4857  end if
4858  norm(r) = min(norm_coli,norm_dd)
4859  end do
4860 
4861  call checktensorslist_cll(tf,tf2,momvec,mominv,masses2,norm,6,rmax,tfdiff)
4862 
4863  if (tferr_aux(rmax).lt.tferr_aux2(rmax)) then
4864  if (present(tferr)) tferr = max(tferr_aux,tfdiff*norm)
4865  do r=0,rmax
4866  tfacc(r) = max(tferr_aux(r)/norm(r),tfdiff(r))
4867  end do
4868  if (monitoring) pointscntften_coli = pointscntften_coli + 1
4869  else
4870  tf = tf2
4871  tfuv = tfuv2
4872  if (present(tferr)) tferr = max(tferr_aux2,tfdiff*norm)
4873  do r=0,rmax
4874  tfacc(r) = max(tferr_aux2(r)/norm(r),tfdiff(r))
4875  end do
4876  if (monitoring) pointscntften_dd = pointscntften_dd + 1
4877  end if
4878 
4879  else
4880  call f_main_cll(cf,cfuv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5), &
4881  mominv(6),mominv(7),mominv(8),mominv(9),mominv(10),mominv(11), &
4882  mominv(12),mominv(13),mominv(14),mominv(15),masses2(0),masses2(1), &
4883  masses2(2),masses2(3),masses2(4),masses2(5),rmax,ferr2=cferr,id_in=0)
4884  call calctensorf_list(tf,tfuv,tferr_aux,cf,cfuv,cferr,momvec,rmax)
4885  if (present(tferr)) tferr = tferr_aux
4886  norm = 0d0
4887  do r=0,rmax
4888  do i=rts(r-1)+1,rts(r)
4889  norm(r) = max(norm(r),abs(tf(i)))
4890  end do
4891  if (norm(r).eq.0d0) then
4892  norm(r) = max(maxval(abs(mominv(1:15))),maxval(abs(masses2(0:5))))
4893  if(norm(r).ne.0d0) then
4894  norm(r)=1d0/norm(r)**(4-real(r)/2)
4895  else
4896  norm(r)=1d0/muir2_cll**(4-real(r)/2)
4897  end if
4898  end if
4899  tfacc(r) = tferr_aux(r)/norm(r)
4900  end do
4901 
4902  end if
4903 
4904  end if
4905 
4906  call propagateaccflag_cll(tfacc,rmax)
4907  call propagateerrflag_cll
4908 
4909  if (monitoring) then
4910  pointscntften_cll = pointscntften_cll + 1
4911 
4912  if(maxval(tfacc).gt.reqacc_cll) accpointscntften_cll = accpointscntften_cll + 1
4913 
4914  if(maxval(tfacc).gt.critacc_cll) then
4915  critpointscntften_cll = critpointscntften_cll + 1
4916  if ( critpointscntften_cll.le.noutcritpointsmax_cll(6) ) then
4917  call critpointsout_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4918  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4919  write(ncpout_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4920  write(ncpout_cll,*)
4921  endif
4922 #ifdef CritPoints2
4923  call critpointsout2_cll('TFten_cll',0,maxval(tfacc),critpointscntften_cll)
4924  if( critpointscntften_cll.eq.noutcritpointsmax_cll(6)) then
4925  write(ncpout2_cll,*) ' Further output of Critical Points for TFten_cll suppressed'
4926  write(ncpout2_cll,*)
4927  endif
4928 #endif
4929  end if
4930  end if
4931  end if
4932 
4933  end subroutine ften_args_list_checked_cll
4934 
4935 
4936 
4937 
4938 
4939  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4940  ! subroutine Gten_main_cll(TG,TGuv,MomVec,MomInv,masses2,rmax,TGerr)
4941  !
4942  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4943 
4944  subroutine gten_main_cll(TG,TGuv,MomVec,MomInv,masses2,rmax,TGerr)
4945 
4946  integer, intent(in) :: rmax
4947  double complex, intent(in) :: MomVec(0:3,6), MomInv(21), masses2(0:6)
4948  double complex, intent(out) :: TG(0:rmax,0:rmax,0:rmax,0:rmax)
4949  double complex, intent(out) :: TGuv(0:rmax,0:rmax,0:rmax,0:rmax)
4950  double precision, intent(out), optional :: TGerr(0:rmax)
4951  double precision :: TGerr_aux(0:rmax), TGerr_aux2(0:rmax)
4952  double complex :: TG2(0:rmax,0:rmax,0:rmax,0:rmax), TGuv2(0:rmax,0:rmax,0:rmax,0:rmax)
4953  double complex :: CG(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4954  double complex :: CGuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
4955  double precision :: CGerr(0:rmax), TGacc(0:rmax)
4956  double precision :: norm(0:rmax),norm_coli,norm_dd, TGdiff(0:rmax)
4957  double complex :: args(52)
4958  integer :: r,n0,n1,n2,n3
4959  logical :: eflag
4960 
4961  if (7.gt.nmax_cll) then
4962  call seterrflag_cll(-10)
4963  call errout_cll('Gten_cll','Nmax_cll smaller 7',eflag,.true.)
4964  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
4965  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 7'
4966  call propagateerrflag_cll
4967  return
4968  end if
4969  if (rmax.gt.rmax_cll) then
4970  call seterrflag_cll(-10)
4971  call errout_cll('Gten_cll','argument rmax larger than rmax_cll',eflag,.true.)
4972  write(nerrout_cll,*) 'rmax =',rmax
4973  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
4974  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
4975  call propagateerrflag_cll
4976  return
4977  end if
4978 
4979  ! set ID of master call
4980  args(1:4) = momvec(0:,1)
4981  args(5:8) = momvec(0:,2)
4982  args(9:12) = momvec(0:,3)
4983  args(13:16) = momvec(0:,4)
4984  args(17:20) = momvec(0:,5)
4985  args(21:24) = momvec(0:,6)
4986  args(25:45) = mominv
4987  args(46:52) = masses2
4988  call setmasterfname_cll('Gten_cll')
4989  call setmastern_cll(7)
4990  call setmasterr_cll(rmax)
4991  call setmasterargs_cll(52,args)
4992 
4993  call settencache_cll(tenred_cll-1)
4994 
4995  if (tenred_cll.le.7) then
4996 
4997  if (mode_cll.gt.1) call tn_dd_dummy(7,rmax)
4998 
4999  if (mode_cll.eq.3) then
5000  ! calculate tensor with coefficients from COLI
5001  mode_cll = 1
5002  call calctensortnr(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax,0)
5003 
5004  ! calculate tensor with coefficients from DD
5005  mode_cll = 2
5006  call calctensortnr(tg2,tguv2,tgerr_aux2,momvec,mominv,masses2,7,rmax,0)
5007 
5008  ! comparison --> take better result
5009  mode_cll = 3
5010  do r=0,rmax
5011  norm_coli=0d0
5012  norm_dd=0d0
5013  do n0=0,r
5014  do n1=0,r-n0
5015  do n2=0,r-n0-n1
5016  n3=r-n0-n1-n2
5017  norm_coli = max(norm_coli,abs(tg(n0,n1,n2,n3)))
5018  norm_dd = max(norm_dd,abs(tg2(n0,n1,n2,n3)))
5019  end do
5020  end do
5021  end do
5022  if (norm_coli.eq.0d0) then
5023  norm_coli = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5024  if(norm_coli.ne.0d0) then
5025  norm_coli=1d0/norm_coli**(5-real(r)/2)
5026  else
5027  norm_coli=1d0/muir2_cll**(5-real(r)/2)
5028  end if
5029  end if
5030  if (norm_dd.eq.0d0) then
5031  norm_dd = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5032  if(norm_dd.ne.0d0) then
5033  norm_dd=1d0/norm_dd**(5-real(r)/2)
5034  else
5035  norm_dd=1d0/muir2_cll**(5-real(r)/2)
5036  end if
5037  end if
5038  norm(r) = min(norm_coli,norm_dd)
5039  end do
5040 
5041  call checktensors_cll(tg,tg2,momvec,mominv,masses2,norm,7,rmax,tgdiff)
5042 
5043  if (tgerr_aux(rmax).lt.tgerr_aux2(rmax)) then
5044  if (present(tgerr)) tgerr = max(tgerr_aux,tgdiff*norm)
5045  do r=0,rmax
5046  tgacc(r) = max(tgerr_aux(r)/norm(r),tgdiff(r))
5047  end do
5048  if (monitoring) pointscntgten_coli = pointscntgten_coli + 1
5049  else
5050  tg = tg2
5051  tguv = tguv2
5052  if (present(tgerr)) tgerr = max(tgerr_aux2,tgdiff*norm)
5053  do r=0,rmax
5054  tgacc(r) = max(tgerr_aux2(r)/norm(r),tgdiff(r))
5055  end do
5056  if (monitoring) pointscntgten_dd = pointscntgten_dd + 1
5057  end if
5058 
5059  else
5060  call calctensortnr(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax,0)
5061  if (present(tgerr)) tgerr = tgerr_aux
5062  norm = 0d0
5063  do r=0,rmax
5064  do n0=0,r
5065  do n1=0,r-n0
5066  do n2=0,r-n0-n1
5067  n3=r-n0-n1-n2
5068  norm(r) = max(norm(r),abs(tg(n0,n1,n2,n3)))
5069  end do
5070  end do
5071  end do
5072  if (norm(r).eq.0d0) then
5073  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5074  if(norm(r).ne.0d0) then
5075  norm(r)=1d0/norm(r)**(5-real(r)/2)
5076  else
5077  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5078  end if
5079  end if
5080  tgacc(r) = tgerr_aux(r)/norm(r)
5081  end do
5082 
5083  end if
5084 
5085  else
5086  call g_main_cll(cg,cguv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
5087  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
5088  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
5089  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1),masses2(2), &
5090  masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr2=cgerr,id_in=0)
5091  call calctensorg(tg,tguv,tgerr_aux,cg,cguv,cgerr,momvec,rmax)
5092  if (present(tgerr)) tgerr = tgerr_aux
5093  norm = 0d0
5094  do r=0,rmax
5095  do n0=0,r
5096  do n1=0,r-n0
5097  do n2=0,r-n0-n1
5098  n3=r-n0-n1-n2
5099  norm(r) = max(norm(r),abs(tg(n0,n1,n2,n3)))
5100  end do
5101  end do
5102  end do
5103  if (norm(r).eq.0d0) then
5104  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5105  if(norm(r).ne.0d0) then
5106  norm(r)=1d0/norm(r)**(5-real(r)/2)
5107  else
5108  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5109  end if
5110  end if
5111  tgacc(r) = tgerr_aux(r)/norm(r)
5112  end do
5113  end if
5114 
5115  if (monitoring) then
5116  if (monitoring) pointscntgten_cll = pointscntgten_cll + 1
5117 
5118  if(maxval(tgacc).gt.reqacc_cll) accpointscntgten_cll = accpointscntgten_cll + 1
5119 
5120  if(maxval(tgacc).gt.critacc_cll) then
5121  critpointscntgten_cll = critpointscntgten_cll + 1
5122  if ( critpointscntgten_cll.le.noutcritpointsmax_cll(7) ) then
5123  call critpointsout_cll('TGten_cll',0,maxval(tgacc),critpointscntgten_cll)
5124  if( critpointscntgten_cll.eq.noutcritpointsmax_cll(7)) then
5125  write(ncpout_cll,*) ' Further output of Critical Points for TGten_cll suppressed'
5126  write(ncpout_cll,*)
5127  endif
5128  end if
5129  end if
5130  end if
5131 
5132  if (monitoring) then
5133  pointscntgten_cll = pointscntgten_cll + 1
5134 
5135  if(maxval(tgacc).gt.reqacc_cll) accpointscntgten_cll = accpointscntgten_cll + 1
5136 
5137  if(maxval(tgacc).gt.critacc_cll) then
5138  critpointscntgten_cll = critpointscntgten_cll + 1
5139  if ( critpointscntgten_cll.le.noutcritpointsmax_cll(7) ) then
5140  call critpointsout_cll('TGten_cll',0,maxval(tgacc),critpointscntgten_cll)
5141  if( critpointscntgten_cll.eq.noutcritpointsmax_cll(7)) then
5142  write(ncpout_cll,*) ' Further output of Critical Points for TGten_cll suppressed'
5143  write(ncpout_cll,*)
5144  endif
5145 #ifdef CritPoints2
5146  call critpointsout2_cll('TGten_cll',0,maxval(tgacc),critpointscntgten_cll)
5147  if( critpointscntgten_cll.eq.noutcritpointsmax_cll(7)) then
5148  write(ncpout2_cll,*) ' Further output of Critical Points for TGten_cll suppressed'
5149  write(ncpout2_cll,*)
5150  endif
5151 #endif
5152  end if
5153  end if
5154  end if
5155 
5156  end subroutine gten_main_cll
5157 
5158 
5159 
5160 
5161 
5162  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5163  ! subroutine Gten_list_cll(TG,TGuv,MomVec,MomInv,masses2,rmax,TGerr)
5164  !
5165  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5166 
5167  subroutine gten_list_cll(TG,TGuv,MomVec,MomInv,masses2,rmax,TGerr)
5168 
5169  integer, intent(in) :: rmax
5170  double complex, intent(in) :: MomVec(0:3,6), MomInv(21), masses2(0:6)
5171  double complex, intent(out) :: TG(:),TGuv(:)
5172  double precision, intent(out), optional :: TGerr(0:rmax)
5173  logical :: eflag
5174 
5175  if (7.gt.nmax_cll) then
5176  call seterrflag_cll(-10)
5177  call errout_cll('Gten_cll','Nmax_cll smaller 7',eflag,.true.)
5178  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
5179  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 7'
5180  call propagateerrflag_cll
5181  return
5182  end if
5183  if (rmax.gt.rmax_cll) then
5184  call seterrflag_cll(-10)
5185  call errout_cll('Gten_cll','argument rmax larger than rmax_cll',eflag,.true.)
5186  write(nerrout_cll,*) 'rmax =',rmax
5187  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
5188  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
5189  call propagateerrflag_cll
5190  return
5191  end if
5192 
5193  call gten_list_checked_cll(tg,tguv,momvec,mominv,masses2,rmax,tgerr)
5194 
5195  end subroutine gten_list_cll
5196 
5197 
5198  subroutine gten_list_checked_cll(TG,TGuv,MomVec,MomInv,masses2,rmax,TGerr)
5199 
5200  integer, intent(in) :: rmax
5201  double complex, intent(in) :: MomVec(0:3,6), MomInv(21), masses2(0:6)
5202  double complex, intent(out) :: TG(RtS(rmax)),TGuv(RtS(rmax))
5203  double precision, intent(out), optional :: TGerr(0:rmax)
5204  double complex :: TG2(RtS(rmax)),TGuv2(RtS(rmax))
5205  double precision :: TGerr_aux(0:rmax),TGerr_aux2(0:rmax)
5206  double complex :: CG(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5207  double complex :: CGuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5208  double precision :: CGerr(0:rmax), TGacc(0:rmax)
5209  double precision :: norm(0:rmax),norm_coli,norm_dd, TGdiff(0:rmax)
5210  double complex :: args(52)
5211  integer :: r,i
5212  logical :: eflag
5213 
5214  ! set ID of master call
5215  args(1:4) = momvec(0:,1)
5216  args(5:8) = momvec(0:,2)
5217  args(9:12) = momvec(0:,3)
5218  args(13:16) = momvec(0:,4)
5219  args(17:20) = momvec(0:,5)
5220  args(21:24) = momvec(0:,6)
5221  args(25:45) = mominv
5222  args(46:52) = masses2
5223  call setmasterfname_cll('Gten_cll')
5224  call setmastern_cll(7)
5225  call setmasterr_cll(rmax)
5226  call setmasterargs_cll(52,args)
5227 
5228  call settencache_cll(tenred_cll-1)
5229 
5230 
5231  if (tenred_cll.le.7) then
5232 
5233  if (mode_cll.gt.1) call tn_dd_dummy(7,rmax)
5234 
5235  if (mode_cll.eq.3) then
5236  ! calculate tensor with coefficients from COLI
5237  mode_cll = 1
5238  call calctensortnr_list(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax)
5239 
5240  ! calculate tensor with coefficients from DD
5241  mode_cll = 2
5242  call calctensortnr_list(tg2,tguv2,tgerr_aux2,momvec,mominv,masses2,7,rmax)
5243 
5244  ! comparison --> take better result
5245  mode_cll = 3
5246  do r=0,rmax
5247  norm_coli=0d0
5248  norm_dd=0d0
5249  do i=rts(r-1)+1,rts(r)
5250  norm_coli = max(norm_coli,abs(tg(i)))
5251  norm_dd = max(norm_dd,abs(tg2(i)))
5252  end do
5253  if (norm_coli.eq.0d0) then
5254  norm_coli = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5255  if(norm_coli.ne.0d0) then
5256  norm_coli=1d0/norm_coli**(5-real(r)/2)
5257  else
5258  norm_coli=1d0/muir2_cll**(5-real(r)/2)
5259  end if
5260  end if
5261  if (norm_dd.eq.0d0) then
5262  norm_dd = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5263  if(norm_dd.ne.0d0) then
5264  norm_dd=1d0/norm_dd**(5-real(r)/2)
5265  else
5266  norm_dd=1d0/muir2_cll**(5-real(r)/2)
5267  end if
5268  end if
5269  norm(r) = min(norm_coli,norm_dd)
5270  end do
5271 
5272  call checktensorslist_cll(tg,tg2,momvec,mominv,masses2,norm,7,rmax,tgdiff)
5273 
5274  if (tgerr_aux(rmax).lt.tgerr_aux2(rmax)) then
5275  if (present(tgerr)) tgerr = max(tgerr_aux,tgdiff*norm)
5276  do r=0,rmax
5277  tgacc(r) = max(tgerr_aux(r)/norm(r),tgdiff(r))
5278  end do
5279  if (monitoring) pointscntgten_coli = pointscntgten_coli + 1
5280  else
5281  tg = tg2
5282  tguv = tguv2
5283  if (present(tgerr)) tgerr = max(tgerr_aux2,tgdiff*norm)
5284  do r=0,rmax
5285  tgacc(r) = max(tgerr_aux2(r)/norm(r),tgdiff(r))
5286  end do
5287  if (monitoring) pointscntgten_dd = pointscntgten_dd + 1
5288  end if
5289 
5290  else
5291  call calctensortnr_list(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax)
5292  if (present(tgerr)) tgerr = tgerr_aux
5293  norm = 0d0
5294  do r=0,rmax
5295  do i=rts(r-1)+1,rts(r)
5296  norm(r) = max(norm(r),abs(tg(i)))
5297  end do
5298  if (norm(r).eq.0d0) then
5299  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5300  if(norm(r).ne.0d0) then
5301  norm(r)=1d0/norm(r)**(5-real(r)/2)
5302  else
5303  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5304  end if
5305  end if
5306  tgacc(r) = tgerr_aux(r)/norm(r)
5307  end do
5308 
5309  end if
5310 
5311  else
5312  call g_main_cll(cg,cguv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
5313  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
5314  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
5315  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1),masses2(2), &
5316  masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr2=cgerr,id_in=0)
5317  call calctensorg_list(tg,tguv,tgerr_aux,cg,cguv,cgerr,momvec,rmax)
5318  if (present(tgerr)) tgerr = tgerr_aux
5319  norm = 0d0
5320  do r=0,rmax
5321  do i=rts(r-1)+1,rts(r)
5322  norm(r) = max(norm(r),abs(tg(i)))
5323  end do
5324  if (norm(r).eq.0d0) then
5325  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5326  if(norm(r).ne.0d0) then
5327  norm(r)=1d0/norm(r)**(5-real(r)/2)
5328  else
5329  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5330  end if
5331  end if
5332  tgacc(r) = tgerr_aux(r)/norm(r)
5333  end do
5334  end if
5335 
5336  if (monitoring) then
5337  pointscntgten_cll = pointscntgten_cll + 1
5338 
5339  if(maxval(tgacc).gt.reqacc_cll) accpointscntgten_cll = accpointscntgten_cll + 1
5340 
5341  if(maxval(tgacc).gt.critacc_cll) then
5342  critpointscntgten_cll = critpointscntgten_cll + 1
5343  if ( critpointscntgten_cll.le.noutcritpointsmax_cll(7) ) then
5344  call critpointsout_cll('TGten_cll',0,maxval(tgacc),critpointscntgten_cll)
5345  if( critpointscntgten_cll.eq.noutcritpointsmax_cll(7)) then
5346  write(ncpout_cll,*) ' Further output of Critical Points for TGten_cll suppressed'
5347  write(ncpout_cll,*)
5348  endif
5349  end if
5350  end if
5351  end if
5352 
5353  end subroutine gten_list_checked_cll
5354 
5355 
5356 
5357 
5358 
5359  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5360  ! subroutine Gten_args_cll(TG,TGuv,p1vec,p2vec,p3vec,p4vec,p5vec,p6vec, &
5361  ! p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
5362  ! p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
5363  ! m02,m12,m22,m32,m42,m52,m62,rmax,TGerr)
5364  !
5365  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5366 
5367  subroutine gten_args_cll(TG,TGuv,p1vec,p2vec,p3vec,p4vec,p5vec,p6vec, &
5368  p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
5369  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
5370  m02,m12,m22,m32,m42,m52,m62,rmax,TGerr)
5371  integer, intent(in) :: rmax
5372  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
5373  double complex, intent(in) :: p5vec(0:3),p6vec(0:3)
5374  double complex, intent(in) :: p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53
5375  double complex, intent(in) :: p64,p50,p61,p30,p41,p52,p63,p40,p51,p62
5376  double complex, intent(in) :: m02,m12,m22,m32,m42,m52,m62
5377  double complex, intent(out) :: TG(0:rmax,0:rmax,0:rmax,0:rmax)
5378  double complex, intent(out) :: TGuv(0:rmax,0:rmax,0:rmax,0:rmax)
5379  double precision, intent(out), optional :: TGerr(0:rmax)
5380  double complex :: TG2(0:rmax,0:rmax,0:rmax,0:rmax), TGuv2(0:rmax,0:rmax,0:rmax,0:rmax)
5381  double precision :: TGerr_aux(0:rmax),TGerr_aux2(0:rmax)
5382  double complex :: MomVec(0:3,6), MomInv(21), masses2(0:6)
5383  double complex :: CG(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5384  double complex :: CGuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5385  double precision :: CGerr(0:rmax), TGacc(0:rmax)
5386  double precision :: norm(0:rmax),norm_coli,norm_dd, TGdiff(0:rmax)
5387  double complex :: args(52)
5388  integer :: r,n0,n1,n2,n3
5389  logical :: eflag
5390 
5391  if (7.gt.nmax_cll) then
5392  call seterrflag_cll(-10)
5393  call errout_cll('Gten_cll','Nmax_cll smaller 7',eflag,.true.)
5394  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
5395  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 7'
5396  call propagateerrflag_cll
5397  return
5398  end if
5399  if (rmax.gt.rmax_cll) then
5400  call seterrflag_cll(-10)
5401  call errout_cll('Gten_cll','argument rmax larger than rmax_cll',eflag,.true.)
5402  write(nerrout_cll,*) 'rmax =',rmax
5403  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
5404  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
5405  call propagateerrflag_cll
5406  return
5407  end if
5408 
5409  momvec(0:,1) = p1vec
5410  momvec(0:,2) = p2vec
5411  momvec(0:,3) = p3vec
5412  momvec(0:,4) = p4vec
5413  momvec(0:,5) = p5vec
5414  momvec(0:,6) = p6vec
5415  mominv(1) = p10
5416  mominv(2) = p21
5417  mominv(3) = p32
5418  mominv(4) = p43
5419  mominv(5) = p54
5420  mominv(6) = p65
5421  mominv(7) = p60
5422  mominv(8) = p20
5423  mominv(9) = p31
5424  mominv(10) = p42
5425  mominv(11) = p53
5426  mominv(12) = p64
5427  mominv(13) = p50
5428  mominv(14) = p61
5429  mominv(15) = p30
5430  mominv(16) = p41
5431  mominv(17) = p52
5432  mominv(18) = p63
5433  mominv(19) = p40
5434  mominv(20) = p51
5435  mominv(21) = p62
5436  masses2(0) = m02
5437  masses2(1) = m12
5438  masses2(2) = m22
5439  masses2(3) = m32
5440  masses2(4) = m42
5441  masses2(5) = m52
5442  masses2(6) = m62
5443 
5444  ! set ID of master call
5445  args(1:4) = momvec(0:,1)
5446  args(5:8) = momvec(0:,2)
5447  args(9:12) = momvec(0:,3)
5448  args(13:16) = momvec(0:,4)
5449  args(17:20) = momvec(0:,5)
5450  args(21:24) = momvec(0:,6)
5451  args(25:45) = mominv
5452  args(46:52) = masses2
5453  call setmasterfname_cll('Gten_cll')
5454  call setmastern_cll(7)
5455  call setmasterr_cll(rmax)
5456  call setmasterargs_cll(52,args)
5457 
5458  call settencache_cll(tenred_cll-1)
5459 
5460 
5461  if (tenred_cll.le.7) then
5462 
5463  if (mode_cll.gt.1) call tn_dd_dummy(7,rmax)
5464 
5465  if (mode_cll.eq.3) then
5466  ! calculate tensor with coefficients from COLI
5467  mode_cll = 1
5468  call calctensortnr(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax,0)
5469 
5470  ! calculate tensor with coefficients from DD
5471  mode_cll = 2
5472  call calctensortnr(tg2,tguv2,tgerr_aux2,momvec,mominv,masses2,7,rmax,0)
5473 
5474  ! comparison --> take better result
5475  mode_cll = 3
5476  do r=0,rmax
5477  norm_coli=0d0
5478  norm_dd=0d0
5479  do n0=0,r
5480  do n1=0,r-n0
5481  do n2=0,r-n0-n1
5482  n3=r-n0-n1-n2
5483  norm_coli = max(norm_coli,abs(tg(n0,n1,n2,n3)))
5484  norm_dd = max(norm_dd,abs(tg2(n0,n1,n2,n3)))
5485  end do
5486  end do
5487  end do
5488  if (norm_coli.eq.0d0) then
5489  norm_coli = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5490  if(norm_coli.ne.0d0) then
5491  norm_coli=1d0/norm_coli**(5-real(r)/2)
5492  else
5493  norm_coli=1d0/muir2_cll**(5-real(r)/2)
5494  end if
5495  end if
5496  if (norm_dd.eq.0d0) then
5497  norm_dd = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5498  if(norm_dd.ne.0d0) then
5499  norm_dd=1d0/norm_dd**(5-real(r)/2)
5500  else
5501  norm_dd=1d0/muir2_cll**(5-real(r)/2)
5502  end if
5503  end if
5504  norm(r) = min(norm_coli,norm_dd)
5505  end do
5506 
5507  call checktensors_cll(tg,tg2,momvec,mominv,masses2,norm,7,rmax,tgdiff)
5508 
5509  if (tgerr_aux(rmax).lt.tgerr_aux2(rmax)) then
5510  if (present(tgerr)) tgerr = max(tgerr_aux,tgdiff*norm)
5511  do r=0,rmax
5512  tgacc(r) = max(tgerr_aux(r)/norm(r),tgdiff(r))
5513  end do
5514  if (monitoring) pointscntgten_coli = pointscntgten_coli + 1
5515  else
5516  tg = tg2
5517  tguv = tguv2
5518  if (present(tgerr)) tgerr = max(tgerr_aux2,tgdiff*norm)
5519  do r=0,rmax
5520  tgacc(r) = max(tgerr_aux2(r)/norm(r),tgdiff(r))
5521  end do
5522  if (monitoring) pointscntgten_dd = pointscntgten_dd + 1
5523  end if
5524 
5525  else
5526  call calctensortnr(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax,0)
5527  if (present(tgerr)) tgerr = tgerr_aux
5528  norm = 0d0
5529  do r=0,rmax
5530  do n0=0,r
5531  do n1=0,r-n0
5532  do n2=0,r-n0-n1
5533  n3=r-n0-n1-n2
5534  norm(r) = max(norm(r),abs(tg(n0,n1,n2,n3)))
5535  end do
5536  end do
5537  end do
5538  if (norm(r).eq.0d0) then
5539  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5540  if(norm(r).ne.0d0) then
5541  norm(r)=1d0/norm(r)**(5-real(r)/2)
5542  else
5543  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5544  end if
5545  end if
5546  tgacc(r) = tgerr_aux(r)/norm(r)
5547  end do
5548 
5549  end if
5550 
5551  else
5552  call g_main_cll(cg,cguv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
5553  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
5554  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
5555  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1),masses2(2), &
5556  masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr2=cgerr,id_in=0)
5557  call calctensorg(tg,tguv,tgerr_aux,cg,cguv,cgerr,momvec,rmax)
5558  if (present(tgerr)) tgerr = tgerr_aux
5559  norm = 0d0
5560  do r=0,rmax
5561  do n0=0,r
5562  do n1=0,r-n0
5563  do n2=0,r-n0-n1
5564  n3=r-n0-n1-n2
5565  norm(r) = max(norm(r),abs(tg(n0,n1,n2,n3)))
5566  end do
5567  end do
5568  end do
5569  if (norm(r).eq.0d0) then
5570  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5571  if(norm(r).ne.0d0) then
5572  norm(r)=1d0/norm(r)**(5-real(r)/2)
5573  else
5574  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5575  end if
5576  end if
5577  tgacc(r) = tgerr_aux(r)/norm(r)
5578  end do
5579  end if
5580 
5581  if (monitoring) then
5582  pointscntgten_cll = pointscntgten_cll + 1
5583 
5584  if(maxval(tgacc).gt.reqacc_cll) accpointscntgten_cll = accpointscntgten_cll + 1
5585 
5586  if(maxval(tgacc).gt.critacc_cll) then
5587  critpointscntgten_cll = critpointscntgten_cll + 1
5588  if ( critpointscntgten_cll.le.noutcritpointsmax_cll(7) ) then
5589  call critpointsout_cll('TGten_cll',0,maxval(tgacc),critpointscntgten_cll)
5590  if( critpointscntgten_cll.eq.noutcritpointsmax_cll(7)) then
5591  write(ncpout_cll,*) ' Further output of Critical Points for TGten_cll suppressed'
5592  write(ncpout_cll,*)
5593  endif
5594  end if
5595  end if
5596  end if
5597 
5598  end subroutine gten_args_cll
5599 
5600 
5601 
5602 
5603 
5604  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5605  ! subroutine Gten_args_list_cll(TG,TGuv,p1vec,p2vec,p3vec,p4vec,p5vec,p6vec, &
5606  ! p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
5607  ! p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
5608  ! m02,m12,m22,m32,m42,m52,m62,rmax,TGerr)
5609  !
5610  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5611 
5612  subroutine gten_args_list_cll(TG,TGuv,p1vec,p2vec,p3vec,p4vec,p5vec,p6vec, &
5613  p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
5614  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
5615  m02,m12,m22,m32,m42,m52,m62,rmax,TGerr)
5616  integer, intent(in) :: rmax
5617  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
5618  double complex, intent(in) :: p5vec(0:3),p6vec(0:3)
5619  double complex, intent(in) :: p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53
5620  double complex, intent(in) :: p64,p50,p61,p30,p41,p52,p63,p40,p51,p62
5621  double complex, intent(in) :: m02,m12,m22,m32,m42,m52,m62
5622  double complex, intent(out) :: TG(RtS(rmax)), TGuv(RtS(rmax))
5623  double precision, intent(out), optional :: TGerr(0:rmax)
5624  double complex :: TG2(RtS(rmax)), TGuv2(RtS(rmax))
5625  double precision :: TGerr_aux(0:rmax), TGerr_aux2(0:rmax)
5626  double complex :: MomVec(0:3,6), MomInv(21), masses2(0:6)
5627  double complex :: CG(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5628  double complex :: CGuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5629  double precision :: CGerr(0:rmax), TGacc(0:rmax)
5630  double precision :: norm(0:rmax), TGdiff(0:rmax), norm_coli, norm_dd
5631  double complex :: args(52)
5632  integer :: r,i
5633  logical :: eflag
5634 
5635  if (7.gt.nmax_cll) then
5636  call seterrflag_cll(-10)
5637  call errout_cll('Gten_cll','Nmax_cll smaller 7',eflag,.true.)
5638  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
5639  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= 7'
5640  call propagateerrflag_cll
5641  return
5642  end if
5643  if (rmax.gt.rmax_cll) then
5644  call seterrflag_cll(-10)
5645  call errout_cll('Gten_cll','argument rmax larger than rmax_cll',eflag,.true.)
5646  write(nerrout_cll,*) 'rmax =',rmax
5647  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
5648  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
5649  call propagateerrflag_cll
5650  return
5651  end if
5652 
5653  call gten_args_list_checked_cll(tg,tguv,p1vec,p2vec,p3vec,p4vec,p5vec,p6vec, &
5654  p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
5655  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
5656  m02,m12,m22,m32,m42,m52,m62,rmax,tgerr)
5657 
5658  end subroutine gten_args_list_cll
5659 
5660 
5661  subroutine gten_args_list_checked_cll(TG,TGuv,p1vec,p2vec,p3vec,p4vec,p5vec,p6vec, &
5662  p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53, &
5663  p64,p50,p61,p30,p41,p52,p63,p40,p51,p62, &
5664  m02,m12,m22,m32,m42,m52,m62,rmax,TGerr)
5665  integer, intent(in) :: rmax
5666  double complex, intent(in) :: p1vec(0:3),p2vec(0:3),p3vec(0:3),p4vec(0:3)
5667  double complex, intent(in) :: p5vec(0:3),p6vec(0:3)
5668  double complex, intent(in) :: p10,p21,p32,p43,p54,p65,p60,p20,p31,p42,p53
5669  double complex, intent(in) :: p64,p50,p61,p30,p41,p52,p63,p40,p51,p62
5670  double complex, intent(in) :: m02,m12,m22,m32,m42,m52,m62
5671  double complex, intent(out) :: TG(RtS(rmax)), TGuv(RtS(rmax))
5672  double precision, intent(out), optional :: TGerr(0:rmax)
5673  double complex :: TG2(RtS(rmax)), TGuv2(RtS(rmax))
5674  double precision :: TGerr_aux(0:rmax), TGerr_aux2(0:rmax)
5675  double complex :: MomVec(0:3,6), MomInv(21), masses2(0:6)
5676  double complex :: CG(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5677  double complex :: CGuv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
5678  double precision :: CGerr(0:rmax), TGacc(0:rmax)
5679  double precision :: norm(0:rmax), TGdiff(0:rmax), norm_coli, norm_dd
5680  double complex :: args(52)
5681  integer :: r,i
5682  logical :: eflag
5683 
5684  momvec(0:,1) = p1vec
5685  momvec(0:,2) = p2vec
5686  momvec(0:,3) = p3vec
5687  momvec(0:,4) = p4vec
5688  momvec(0:,5) = p5vec
5689  momvec(0:,6) = p6vec
5690  mominv(1) = p10
5691  mominv(2) = p21
5692  mominv(3) = p32
5693  mominv(4) = p43
5694  mominv(5) = p54
5695  mominv(6) = p65
5696  mominv(7) = p60
5697  mominv(8) = p20
5698  mominv(9) = p31
5699  mominv(10) = p42
5700  mominv(11) = p53
5701  mominv(12) = p64
5702  mominv(13) = p50
5703  mominv(14) = p61
5704  mominv(15) = p30
5705  mominv(16) = p41
5706  mominv(17) = p52
5707  mominv(18) = p63
5708  mominv(19) = p40
5709  mominv(20) = p51
5710  mominv(21) = p62
5711  masses2(0) = m02
5712  masses2(1) = m12
5713  masses2(2) = m22
5714  masses2(3) = m32
5715  masses2(4) = m42
5716  masses2(5) = m52
5717  masses2(6) = m62
5718 
5719  ! set ID of master call
5720  args(1:4) = momvec(0:,1)
5721  args(5:8) = momvec(0:,2)
5722  args(9:12) = momvec(0:,3)
5723  args(13:16) = momvec(0:,4)
5724  args(17:20) = momvec(0:,5)
5725  args(21:24) = momvec(0:,6)
5726  args(25:45) = mominv
5727  args(46:52) = masses2
5728  call setmasterfname_cll('Gten_cll')
5729  call setmastern_cll(7)
5730  call setmasterr_cll(rmax)
5731  call setmasterargs_cll(52,args)
5732 
5733  call settencache_cll(tenred_cll-1)
5734 
5735 
5736  if (tenred_cll.le.7) then
5737 
5738  if (mode_cll.gt.1) call tn_dd_dummy(7,rmax)
5739 
5740  if (mode_cll.eq.3) then
5741  ! calculate tensor with coefficients from COLI
5742  mode_cll = 1
5743  call calctensortnr_list(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax)
5744 
5745  ! calculate tensor with coefficients from DD
5746  mode_cll = 2
5747  call calctensortnr_list(tg2,tguv2,tgerr_aux2,momvec,mominv,masses2,7,rmax)
5748 
5749  ! comparison --> take better result
5750  mode_cll = 3
5751  do r=0,rmax
5752  norm_coli=0d0
5753  norm_dd=0d0
5754  do i=rts(r-1)+1,rts(r)
5755  norm_coli = max(norm_coli,abs(tg(i)))
5756  norm_dd = max(norm_dd,abs(tg2(i)))
5757  end do
5758  if (norm_coli.eq.0d0) then
5759  norm_coli = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5760  if(norm_coli.ne.0d0) then
5761  norm_coli=1d0/norm_coli**(5-real(r)/2)
5762  else
5763  norm_coli=1d0/muir2_cll**(5-real(r)/2)
5764  end if
5765  end if
5766  if (norm_dd.eq.0d0) then
5767  norm_dd = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5768  if(norm_dd.ne.0d0) then
5769  norm_dd=1d0/norm_dd**(5-real(r)/2)
5770  else
5771  norm_dd=1d0/muir2_cll**(5-real(r)/2)
5772  end if
5773  end if
5774  norm(r) = min(norm_coli,norm_dd)
5775  end do
5776 
5777  call checktensorslist_cll(tg,tg2,momvec,mominv,masses2,norm,7,rmax,tgdiff)
5778 
5779  if (tgerr_aux(rmax).lt.tgerr_aux2(rmax)) then
5780  if (present(tgerr)) tgerr = max(tgerr_aux,tgdiff*norm)
5781  do r=0,rmax
5782  tgacc(r) = max(tgerr_aux(r)/norm(r),tgdiff(r))
5783  end do
5784  if (monitoring) pointscntgten_coli = pointscntgten_coli + 1
5785  else
5786  tg = tg2
5787  tguv = tguv2
5788  if (present(tgerr)) tgerr = max(tgerr_aux2,tgdiff*norm)
5789  do r=0,rmax
5790  tgacc(r) = max(tgerr_aux2(r)/norm(r),tgdiff(r))
5791  end do
5792  if (monitoring) pointscntgten_dd = pointscntgten_dd + 1
5793  end if
5794 
5795  else
5796  call calctensortnr_list(tg,tguv,tgerr_aux,momvec,mominv,masses2,7,rmax)
5797  if (present(tgerr)) tgerr = tgerr_aux
5798  norm = 0d0
5799  do r=0,rmax
5800  do i=rts(r-1)+1,rts(r)
5801  norm(r) = max(norm(r),abs(tg(i)))
5802  end do
5803  if (norm(r).eq.0d0) then
5804  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5805  if(norm(r).ne.0d0) then
5806  norm(r)=1d0/norm(r)**(5-real(r)/2)
5807  else
5808  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5809  end if
5810  end if
5811  tgacc(r) = tgerr_aux(r)/norm(r)
5812  end do
5813 
5814  end if
5815 
5816  else
5817  call g_main_cll(cg,cguv,mominv(1),mominv(2),mominv(3),mominv(4),mominv(5),mominv(6), &
5818  mominv(7),mominv(8),mominv(9),mominv(10),mominv(11),mominv(12), &
5819  mominv(13),mominv(14),mominv(15),mominv(16),mominv(17),mominv(18), &
5820  mominv(19),mominv(20),mominv(21),masses2(0),masses2(1),masses2(2), &
5821  masses2(3),masses2(4),masses2(5),masses2(6),rmax,gerr2=cgerr,id_in=0)
5822  call calctensorg_list(tg,tguv,tgerr_aux,cg,cguv,cgerr,momvec,rmax)
5823  if (present(tgerr)) tgerr = tgerr_aux
5824  norm = 0d0
5825  do r=0,rmax
5826  do i=rts(r-1)+1,rts(r)
5827  norm(r) = max(norm(r),abs(tg(i)))
5828  end do
5829  if (norm(r).eq.0d0) then
5830  norm(r) = max(maxval(abs(mominv(1:21))),maxval(abs(masses2(0:6))))
5831  if(norm(r).ne.0d0) then
5832  norm(r)=1d0/norm(r)**(5-real(r)/2)
5833  else
5834  norm(r)=1d0/muir2_cll**(5-real(r)/2)
5835  end if
5836  end if
5837  tgacc(r) = tgerr_aux(r)/norm(r)
5838  end do
5839  end if
5840 
5841  if (monitoring) then
5842  pointscntgten_cll = pointscntgten_cll + 1
5843 
5844  if(maxval(tgacc).gt.reqacc_cll) accpointscntgten_cll = accpointscntgten_cll + 1
5845 
5846  if(maxval(tgacc).gt.critacc_cll) then
5847  critpointscntgten_cll = critpointscntgten_cll + 1
5848  if ( critpointscntgten_cll.le.noutcritpointsmax_cll(7) ) then
5849  call critpointsout_cll('TGten_cll',0,maxval(tgacc),critpointscntgten_cll)
5850  if( critpointscntgten_cll.eq.noutcritpointsmax_cll(7)) then
5851  write(ncpout_cll,*) ' Further output of Critical Points for TGten_cll suppressed'
5852  write(ncpout_cll,*)
5853  endif
5854 #ifdef CritPoints2
5855  call critpointsout2_cll('TGten_cll',0,maxval(tgacc),critpointscntgten_cll)
5856  if( critpointscntgten_cll.eq.noutcritpointsmax_cll(7)) then
5857  write(ncpout2_cll,*) ' Further output of Critical Points for TGten_cll suppressed'
5858  write(ncpout2_cll,*)
5859  endif
5860 #endif
5861  end if
5862  end if
5863  end if
5864 
5865  end subroutine gten_args_list_checked_cll
5866 
5867 
5868 
5869 
5870 
5871  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5872  ! subroutine TNten_main_cll(TN,TNuv,MomVec,MomInv,masses2,N,rmax,TNerr)
5873  !
5874  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5875 
5876  subroutine tnten_main_cll(TN,TNuv,MomVec,MomInv,masses2,N,rmax,TNerr)
5877 
5878  integer, intent(in) :: N,rmax
5879  double complex, intent(in) :: MomVec(0:3,max(N-1,1)), MomInv(:), masses2(0:max(N-1,1))
5880  double complex, intent(out) :: TN(0:rmax,0:rmax,0:rmax,0:rmax)
5881  double complex, intent(out) :: TNuv(0:rmax,0:rmax,0:rmax,0:rmax)
5882  double precision, intent(out), optional :: TNerr(0:rmax)
5883  logical :: eflag
5884 
5885  if (n.eq.1) then
5886  call seterrflag_cll(-10)
5887  call errout_cll('TNten_cll','subroutine called with wrong number of arguments for N=1',eflag)
5888  call propagateerrflag_cll
5889  return
5890  end if
5891 
5892  if (n.gt.nmax_cll) then
5893  call seterrflag_cll(-10)
5894  call errout_cll('TN_cll','argument N larger than Nmax_cll',eflag,.true.)
5895  write(nerrout_cll,*) 'N =',n
5896  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
5897  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= ',n
5898  call propagateerrflag_cll
5899  return
5900  end if
5901  if (rmax.gt.rmax_cll) then
5902  call seterrflag_cll(-10)
5903  call errout_cll('TN_cll','argument rmax larger than rmax_cll',eflag,.true.)
5904  write(nerrout_cll,*) 'rmax =',rmax
5905  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
5906  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
5907  call propagateerrflag_cll
5908  return
5909  end if
5910 
5911  call tnten_main_checked_cll(tn,tnuv,momvec,mominv,masses2,n,rmax,tnerr)
5912 
5913  end subroutine tnten_main_cll
5914 
5915 
5916  subroutine tnten_main_checked_cll(TN,TNuv,MomVec,MomInv,masses2,N,rmax,TNerr)
5917 
5918  integer, intent(in) :: N,rmax
5919  double complex, intent(in) :: MomVec(0:3,max(N-1,1)), MomInv(BinomTable(2,N)), masses2(0:max(N-1,1))
5920  double complex, intent(out) :: TN(0:rmax,0:rmax,0:rmax,0:rmax)
5921  double complex, intent(out) :: TNuv(0:rmax,0:rmax,0:rmax,0:rmax)
5922  double precision, intent(out), optional :: TNerr(0:rmax)
5923  double complex :: TN2(0:rmax,0:rmax,0:rmax,0:rmax), TNuv2(0:rmax,0:rmax,0:rmax,0:rmax)
5924  double complex :: CN(NCoefs(rmax,N))
5925  double complex :: CNuv(NCoefs(rmax,N))
5926  double precision :: CNerr(0:rmax), TNerr_aux(0:rmax), TNerr_aux2(0:rmax)
5927  double complex :: args(4*(N-1)+BinomTable(2,N)+N)
5928  integer :: i
5929  double precision :: TNdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TNacc(0:rmax)
5930  integer :: r,n0,n1,n2,n3
5931  logical :: eflag
5932 
5933  if (n.eq.1) then
5934  call seterrflag_cll(-10)
5935  call errout_cll('TNten_cll','subroutine called with wrong number of arguments for N=1',eflag)
5936  return
5937  end if
5938 
5939  do i=1,n-1
5940  args(4*i-3:4*i) = momvec(0:,i)
5941  end do
5942  args(4*(n-1)+1:4*(n-1)+binomtable(2,n)) = mominv
5943  args(4*(n-1)+binomtable(2,n)+1:4*(n-1)+binomtable(2,n)+n) = masses2(0:)
5944  call setmasterfname_cll('TNten_cll')
5945  call setmastern_cll(n)
5946  call setmasterr_cll(rmax)
5947  call setmasterargs_cll(4*(n-1)+binomtable(2,n)+n,args)
5948 
5949  call settencache_cll(tenred_cll-1)
5950 
5951 
5952  if (tenred_cll.le.n+1) then
5953 
5954  if (mode_cll.gt.1) call tn_dd_dummy(n,rmax)
5955 
5956  if (mode_cll.eq.3) then
5957  ! calculate tensor with coefficients from COLI
5958  mode_cll = 1
5959  call calctensortnr(tn,tnuv,tnerr_aux,momvec,mominv,masses2,n,rmax,0)
5960 
5961  ! calculate tensor with coefficients from DD
5962  mode_cll = 2
5963  call calctensortnr(tn2,tnuv2,tnerr_aux2,momvec,mominv,masses2,n,rmax,0)
5964 
5965  ! comparison --> take better result
5966  mode_cll = 3
5967  do r=0,rmax
5968  norm_coli=0d0
5969  norm_dd=0d0
5970  do n0=0,r
5971  do n1=0,r-n0
5972  do n2=0,r-n0-n1
5973  n3=r-n0-n1-n2
5974  norm_coli = max(norm_coli,abs(tn(n0,n1,n2,n3)))
5975  norm_dd = max(norm_dd,abs(tn2(n0,n1,n2,n3)))
5976  end do
5977  end do
5978  end do
5979  if (norm_coli.eq.0d0) then
5980  norm_coli = max(maxval(abs(mominv(1:binomtable(2,n)))), &
5981  maxval(abs(masses2(0:n-1))))
5982  if(norm_coli.ne.0d0) then
5983  norm_coli=1d0/norm_coli**(n-2-real(r)/2)
5984  else
5985  norm_coli=1d0/muir2_cll**(n-2-real(r)/2)
5986  end if
5987  end if
5988  if (norm_dd.eq.0d0) then
5989  norm_dd = max(maxval(abs(mominv(1:binomtable(2,n)))), &
5990  maxval(abs(masses2(0:n-1))))
5991  if(norm_dd.ne.0d0) then
5992  norm_dd=1d0/norm_dd**(n-2-real(r)/2)
5993  else
5994  norm_dd=1d0/muir2_cll**(n-2-real(r)/2)
5995  end if
5996  end if
5997  norm(r) = min(norm_coli,norm_dd)
5998  end do
5999 
6000  call checktensors_cll(tn,tn2,momvec,mominv,masses2,norm,n,rmax,tndiff)
6001 
6002  if (tnerr_aux(rmax).lt.tnerr_aux2(rmax)) then
6003  if (present(tnerr)) tnerr = max(tnerr_aux,tndiff*norm)
6004  do r=0,rmax
6005  tnacc(r) = max(tnerr_aux(r)/norm(r),tndiff(r))
6006  end do
6007  if (monitoring) pointscnttnten_coli(n) = pointscnttnten_coli(n) + 1
6008  else
6009  tn = tn2
6010  tnuv = tnuv2
6011  if (present(tnerr)) tnerr = max(tnerr_aux2,tndiff*norm)
6012  do r=0,rmax
6013  tnacc(r) = max(tnerr_aux2(r)/norm(r),tndiff(r))
6014  end do
6015  if (monitoring) pointscnttnten_dd(n) = pointscnttnten_dd(n) + 1
6016  end if
6017 
6018  else
6019  call calctensortnr(tn,tnuv,tnerr_aux,momvec,mominv,masses2,n,rmax,0)
6020  if (present(tnerr)) tnerr = tnerr_aux
6021  do r=0,rmax
6022  norm(r)=0d0
6023  do n0=0,r
6024  do n1=0,r-n0
6025  do n2=0,r-n0-n1
6026  n3=r-n0-n1-n2
6027  norm(r) = max(norm(r),abs(tn(n0,n1,n2,n3)))
6028  end do
6029  end do
6030  end do
6031  if (norm(r).eq.0d0) then
6032  norm(r) = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6033  maxval(abs(masses2(0:n-1))))
6034  if(norm(r).ne.0d0) then
6035  norm(r)=1d0/norm(r)**(n-2-real(r)/2)
6036  else
6037  norm(r)=1d0/muir2_cll**(n-2-real(r)/2)
6038  end if
6039  end if
6040  end do
6041  do r=0,rmax
6042  tnacc(r) = tnerr_aux(r)/norm(r)
6043  end do
6044 
6045  end if
6046 
6047  else
6048 
6049  if (mode_cll.eq.3) then
6050  ! calculate tensor with coefficients from COLI
6051  mode_cll = 1
6052  call tn_cll(cn,cnuv,mominv,masses2,n,rmax,tnerr2=cnerr,id_in=0)
6053  call calctensortn(tn,tnuv,tnerr_aux,cn,cnuv,cnerr,momvec,n,rmax)
6054 
6055  ! calculate tensor with coefficients from DD
6056  mode_cll = 2
6057  call tn_cll(cn,cnuv,mominv,masses2,n,rmax,tnerr2=cnerr,id_in=0)
6058  call calctensortn(tn2,tnuv2,tnerr_aux2,cn,cnuv,cnerr,momvec,n,rmax)
6059 
6060  ! comparison --> take better result
6061  mode_cll = 3
6062  do r=0,rmax
6063  norm_coli=0d0
6064  norm_dd=0d0
6065  do n0=0,r
6066  do n1=0,r-n0
6067  do n2=0,r-n0-n1
6068  n3=r-n0-n1-n2
6069  norm_coli = max(norm_coli,abs(tn(n0,n1,n2,n3)))
6070  norm_dd = max(norm_dd,abs(tn2(n0,n1,n2,n3)))
6071  end do
6072  end do
6073  end do
6074  if (norm_coli.eq.0d0) then
6075  norm_coli = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6076  maxval(abs(masses2(0:n-1))))
6077  if(norm_coli.ne.0d0) then
6078  norm_coli=1d0/norm_coli**(n-2-real(r)/2)
6079  else
6080  norm_coli=1d0/muir2_cll**(n-2-real(r)/2)
6081  end if
6082  end if
6083  if (norm_dd.eq.0d0) then
6084  norm_dd = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6085  maxval(abs(masses2(0:n-1))))
6086  if(norm_dd.ne.0d0) then
6087  norm_dd=1d0/norm_dd**(n-2-real(r)/2)
6088  else
6089  norm_dd=1d0/muir2_cll**(n-2-real(r)/2)
6090  end if
6091  end if
6092  norm(r) = min(norm_coli,norm_dd)
6093  end do
6094 
6095  call checktensors_cll(tn,tn2,momvec,mominv,masses2,norm,n,rmax,tndiff)
6096 
6097  if (tnerr_aux(rmax).lt.tnerr_aux2(rmax)) then
6098  if (present(tnerr)) tnerr = max(tnerr_aux,tndiff*norm)
6099  do r=0,rmax
6100  tnacc(r) = max(tnerr_aux(r)/norm(r),tndiff(r))
6101  end do
6102  if (monitoring) pointscnttnten_coli(n) = pointscnttnten_coli(n) + 1
6103  else
6104  tn = tn2
6105  tnuv = tnuv2
6106  if (present(tnerr)) tnerr = max(tnerr_aux2,tndiff*norm)
6107  do r=0,rmax
6108  tnacc(r) = max(tnerr_aux2(r)/norm(r),tndiff(r))
6109  end do
6110  if (monitoring) pointscnttnten_dd(n) = pointscnttnten_dd(n) + 1
6111  end if
6112 
6113  else
6114  call tn_cll(cn,cnuv,mominv,masses2,n,rmax,tnerr2=cnerr,id_in=0)
6115  call calctensortn(tn,tnuv,tnerr_aux,cn,cnuv,cnerr,momvec,n,rmax)
6116  if (present(tnerr)) tnerr = tnerr_aux
6117  do r=0,rmax
6118  norm(r)=0d0
6119  do n0=0,r
6120  do n1=0,r-n0
6121  do n2=0,r-n0-n1
6122  n3=r-n0-n1-n2
6123  norm(r) = max(norm(r),abs(tn(n0,n1,n2,n3)))
6124  end do
6125  end do
6126  end do
6127  if (norm(r).eq.0d0) then
6128  norm(r) = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6129  maxval(abs(masses2(0:n-1))))
6130  if(norm(r).ne.0d0) then
6131  norm(r)=1d0/norm(r)**(n-2-real(r)/2)
6132  else
6133  norm(r)=1d0/muir2_cll**(n-2-real(r)/2)
6134  end if
6135  end if
6136  end do
6137  do r=0,rmax
6138  tnacc(r) = tnerr_aux(r)/norm(r)
6139  end do
6140 
6141  end if
6142 
6143  end if
6144 
6145  call propagateaccflag_cll(tnacc,rmax)
6146  call propagateerrflag_cll
6147 
6148  if (monitoring) then
6149  pointscnttnten_cll(n) = pointscnttnten_cll(n) + 1
6150 
6151  if(maxval(tnacc).gt.reqacc_cll) accpointscnttnten_cll(n) = accpointscnttnten_cll(n) + 1
6152 
6153  if(maxval(tnacc).gt.critacc_cll) then
6154  critpointscnttnten_cll(n) = critpointscnttnten_cll(n) + 1
6155  if ( critpointscnttnten_cll(n).le.noutcritpointsmax_cll(n) ) then
6156  call critpointsout_cll('TNten_cll',n,maxval(tnacc),critpointscnttnten_cll(n))
6157  if( critpointscnttnten_cll(n).eq.noutcritpointsmax_cll(n)) then
6158  write(ncpout_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',n
6159  write(ncpout_cll,*)
6160  endif
6161 #ifdef CritPoints2
6162  call critpointsout2_cll('TNten_cll',n,maxval(tnacc),critpointscnttnten_cll(n))
6163  if( critpointscnttnten_cll(n).eq.noutcritpointsmax_cll(n)) then
6164  write(ncpout2_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',n
6165  write(ncpout2_cll,*)
6166  endif
6167 #endif
6168  end if
6169  end if
6170  end if
6171 
6172  end subroutine tnten_main_checked_cll
6173 
6174 
6175 
6176 
6177 
6178  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6179  ! subroutine TNten_list_cll(TN,TNuv,MomVec,MomInv,masses2,N,rmax,TNerr)
6180  !
6181  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6182 
6183  subroutine tnten_list_cll(TN,TNuv,MomVec,MomInv,masses2,N,rmax,TNerr)
6184 
6185  integer, intent(in) :: N,rmax
6186  double complex, intent(in) :: MomVec(0:3,max(N-1,1)), MomInv(:), masses2(0:max(N-1,1))
6187  double complex, intent(out) :: TN(:),TNuv(:)
6188  double precision, intent(out), optional :: TNerr(0:rmax)
6189  logical :: eflag
6190 
6191  if (n.eq.1) then
6192  call seterrflag_cll(-10)
6193  call errout_cll('TNten_cll','subroutine called with wrong number of arguments for N=1',eflag)
6194  call propagateerrflag_cll
6195  return
6196  end if
6197  if (n.gt.nmax_cll) then
6198  call seterrflag_cll(-10)
6199  call errout_cll('TNten_cll','argument N larger than Nmax_cll',eflag,.true.)
6200  write(nerrout_cll,*) 'N =',n
6201  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
6202  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= ',n
6203  call propagateerrflag_cll
6204  return
6205  end if
6206  if (rmax.gt.rmax_cll) then
6207  call seterrflag_cll(-10)
6208  call errout_cll('TNten_cll','argument rmax larger than rmax_cll',eflag,.true.)
6209  write(nerrout_cll,*) 'rmax =',rmax
6210  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
6211  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
6212  call propagateerrflag_cll
6213  return
6214  end if
6215 
6216  call tnten_list_checked_cll(tn,tnuv,momvec,mominv,masses2,n,rmax,tnerr)
6217 
6218  end subroutine tnten_list_cll
6219 
6220 
6221 
6222  subroutine tnten_list_checked_cll(TN,TNuv,MomVec,MomInv,masses2,N,rmax,TNerr)
6223 
6224  integer, intent(in) :: N,rmax
6225  double complex, intent(in) :: MomVec(0:3,max(N-1,1)), MomInv(BinomTable(2,N)), masses2(0:max(N-1,1))
6226  double complex, intent(out) :: TN(RtS(rmax)),TNuv(RtS(rmax))
6227  double precision, intent(out), optional :: TNerr(0:rmax)
6228  double complex :: TN2(RtS(rmax)),TNuv2(RtS(rmax))
6229  double complex :: CN(NCoefs(rmax,N)),CNuv(NCoefs(rmax,N))
6230  double precision :: CNerr(0:rmax), TNerr_aux(0:rmax), TNerr_aux2(0:rmax)
6231  double complex :: args(4*(N-1)+BinomTable(2,N)+N)
6232  double precision :: TNdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TNacc(0:rmax)
6233  integer :: r,i
6234  logical :: eflag
6235 
6236 ! if (N.eq.1) then
6237 ! call SetErrFlag_cll(-10)
6238 ! call ErrOut_cll('TNten_cll','subroutine called with wrong number of arguments for N=1',eflag)
6239 ! return
6240 ! end if
6241 
6242  do i=1,n-1
6243  args(4*i-3:4*i) = momvec(0:,i)
6244  end do
6245  args(4*(n-1)+1:4*(n-1)+binomtable(2,n)) = mominv
6246  args(4*(n-1)+binomtable(2,n)+1:4*(n-1)+binomtable(2,n)+n) = masses2(0:)
6247  call setmasterfname_cll('TNten_cll')
6248  call setmastern_cll(n)
6249  call setmasterr_cll(rmax)
6250  call setmasterargs_cll(4*(n-1)+binomtable(2,n)+n,args)
6251 
6252  call settencache_cll(tenred_cll-1)
6253 
6254 
6255  if (tenred_cll.le.n+1) then
6256 
6257  if (mode_cll.gt.1) call tn_dd_dummy(n,rmax)
6258 
6259  if (mode_cll.eq.3) then
6260  ! calculate tensor with coefficients from COLI
6261  mode_cll = 1
6262 
6263  call calctensortnr_list(tn,tnuv,tnerr_aux,momvec,mominv,masses2,n,rmax)
6264  ! calculate tensor with coefficients from DD
6265  mode_cll = 2
6266  call calctensortnr_list(tn2,tnuv2,tnerr_aux2,momvec,mominv,masses2,n,rmax)
6267 
6268  ! comparison --> take better result
6269  mode_cll = 3
6270  do r=0,rmax
6271  norm_coli=0d0
6272  norm_dd=0d0
6273  do i=rts(r-1)+1,rts(r)
6274  norm_coli = max(norm_coli,abs(tn(i)))
6275  norm_dd = max(norm_dd,abs(tn2(i)))
6276  end do
6277  if (norm_coli.eq.0d0) then
6278  norm_coli = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6279  maxval(abs(masses2(0:n-1))))
6280  if(norm_coli.ne.0d0) then
6281  norm_coli=1d0/norm_coli**(n-2-real(r)/2)
6282  else
6283  norm_coli=1d0/muir2_cll**(n-2-real(r)/2)
6284  end if
6285  end if
6286  if (norm_dd.eq.0d0) then
6287  norm_dd = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6288  maxval(abs(masses2(0:n-1))))
6289  if(norm_dd.ne.0d0) then
6290  norm_dd=1d0/norm_dd**(n-2-real(r)/2)
6291  else
6292  norm_dd=1d0/muir2_cll**(n-2-real(r)/2)
6293  end if
6294  end if
6295  norm(r) = min(norm_coli,norm_dd)
6296  end do
6297 
6298  call checktensorslist_cll(tn,tn2,momvec,mominv,masses2,norm,n,rmax,tndiff)
6299 
6300  if (tnerr_aux(rmax).lt.tnerr_aux2(rmax)) then
6301  if (present(tnerr)) tnerr = max(tnerr_aux,tndiff*norm)
6302  do r=0,rmax
6303  tnacc(r) = max(tnerr_aux(r)/norm(r),tndiff(r))
6304  end do
6305  if (monitoring) pointscnttnten_coli(n) = pointscnttnten_coli(n) + 1
6306  else
6307  tn = tn2
6308  tnuv = tnuv2
6309  if (present(tnerr)) tnerr = max(tnerr_aux2,tndiff*norm)
6310  do r=0,rmax
6311  tnacc(r) = max(tnerr_aux2(r)/norm(r),tndiff(r))
6312  end do
6313  if (monitoring) pointscnttnten_dd(n) = pointscnttnten_dd(n) + 1
6314  end if
6315 
6316  else
6317  call calctensortnr_list(tn,tnuv,tnerr_aux,momvec,mominv,masses2,n,rmax)
6318  if (present(tnerr)) tnerr = tnerr_aux
6319 
6320  do r=0,rmax
6321  norm(r)=0d0
6322  do i=rts(r-1)+1,rts(r)
6323  norm(r) = max(norm(r),abs(tn(i)))
6324  end do
6325  if (norm(r).eq.0d0) then
6326  norm(r) = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6327  maxval(abs(masses2(0:n-1))))
6328  if(norm(r).ne.0d0) then
6329  norm(r)=1d0/norm(r)**(n-2-real(r)/2)
6330  else
6331  norm(r)=1d0/muir2_cll**(n-2-real(r)/2)
6332  end if
6333  end if
6334  end do
6335  do r=0,rmax
6336  tnacc(r) = tnerr_aux(r)/norm(r)
6337  end do
6338 
6339  end if
6340 
6341  else
6342 
6343 
6344  if (mode_cll.eq.3) then
6345  ! calculate tensor with coefficients from COLI
6346  mode_cll = 1
6347  call tn_cll(cn,cnuv,mominv,masses2,n,rmax,tnerr2=cnerr,id_in=0)
6348  call calctensortn_list(tn,tnuv,tnerr_aux,cn,cnuv,cnerr,momvec,n,rmax)
6349  ! calculate tensor with coefficients from DD
6350  mode_cll = 2
6351  call tn_cll(cn,cnuv,mominv,masses2,n,rmax,tnerr2=cnerr,id_in=0)
6352  call calctensortn_list(tn2,tnuv2,tnerr_aux2,cn,cnuv,cnerr,momvec,n,rmax)
6353 
6354  ! comparison --> take better result
6355  mode_cll = 3
6356  do r=0,rmax
6357  norm_coli=0d0
6358  norm_dd=0d0
6359  do i=rts(r-1)+1,rts(r)
6360  norm_coli = max(norm_coli,abs(tn(i)))
6361  norm_dd = max(norm_dd,abs(tn2(i)))
6362  end do
6363  if (norm_coli.eq.0d0) then
6364  norm_coli = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6365  maxval(abs(masses2(0:n-1))))
6366  if(norm_coli.ne.0d0) then
6367  norm_coli=1d0/norm_coli**(n-2-real(r)/2)
6368  else
6369  norm_coli=1d0/muir2_cll**(n-2-real(r)/2)
6370  end if
6371  end if
6372  if (norm_dd.eq.0d0) then
6373  norm_dd = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6374  maxval(abs(masses2(0:n-1))))
6375  if(norm_dd.ne.0d0) then
6376  norm_dd=1d0/norm_dd**(n-2-real(r)/2)
6377  else
6378  norm_dd=1d0/muir2_cll**(n-2-real(r)/2)
6379  end if
6380  end if
6381  norm(r) = min(norm_coli,norm_dd)
6382  end do
6383 
6384  call checktensorslist_cll(tn,tn2,momvec,mominv,masses2,norm,n,rmax,tndiff)
6385 
6386  if (tnerr_aux(rmax).lt.tnerr_aux2(rmax)) then
6387  if (present(tnerr)) tnerr = max(tnerr_aux,tndiff*norm)
6388  do r=0,rmax
6389  tnacc(r) = max(tnerr_aux(r)/norm(r),tndiff(r))
6390  end do
6391  if (monitoring) pointscnttnten_coli(n) = pointscnttnten_coli(n) + 1
6392  else
6393  tn = tn2
6394  tnuv = tnuv2
6395  if (present(tnerr)) tnerr = max(tnerr_aux2,tndiff*norm)
6396  do r=0,rmax
6397  tnacc(r) = max(tnerr_aux2(r)/norm(r),tndiff(r))
6398  end do
6399  if (monitoring) pointscnttnten_dd(n) = pointscnttnten_dd(n) + 1
6400  end if
6401 
6402  else
6403  call tn_cll(cn,cnuv,mominv,masses2,n,rmax,tnerr2=cnerr,id_in=0)
6404  call calctensortn_list(tn,tnuv,tnerr_aux,cn,cnuv,cnerr,momvec,n,rmax)
6405 
6406  if (present(tnerr)) tnerr = tnerr_aux
6407 
6408  do r=0,rmax
6409  norm(r)=0d0
6410  do i=rts(r-1)+1,rts(r)
6411  norm(r) = max(norm(r),abs(tn(i)))
6412  end do
6413  if (norm(r).eq.0d0) then
6414  norm(r) = max(maxval(abs(mominv(1:binomtable(2,n)))), &
6415  maxval(abs(masses2(0:n-1))))
6416  if(norm(r).ne.0d0) then
6417  norm(r)=1d0/norm(r)**(n-2-real(r)/2)
6418  else
6419  norm(r)=1d0/muir2_cll**(n-2-real(r)/2)
6420  end if
6421  end if
6422  end do
6423  do r=0,rmax
6424  tnacc(r) = tnerr_aux(r)/norm(r)
6425  end do
6426 
6427  end if
6428 
6429  end if
6430 
6431  call propagateaccflag_cll(tnacc,rmax)
6432  call propagateerrflag_cll
6433 
6434  if (monitoring) then
6435  pointscnttnten_cll(n) = pointscnttnten_cll(n) + 1
6436 
6437  if(maxval(tnacc).gt.reqacc_cll) accpointscnttnten_cll(n) = accpointscnttnten_cll(n) + 1
6438 
6439  if(maxval(tnacc).gt.critacc_cll) then
6440  critpointscnttnten_cll(n) = critpointscnttnten_cll(n) + 1
6441  if ( critpointscnttnten_cll(n).le.noutcritpointsmax_cll(n) ) then
6442  call critpointsout_cll('TNten_cll',n,maxval(tnacc),critpointscnttnten_cll(n))
6443  if( critpointscnttnten_cll(n).eq.noutcritpointsmax_cll(n)) then
6444  write(ncpout_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',n
6445  write(ncpout_cll,*)
6446  endif
6447 #ifdef CritPoints2
6448  call critpointsout2_cll('TNten_cll',n,maxval(tnacc),critpointscnttnten_cll(n))
6449  if( critpointscnttnten_cll(n).eq.noutcritpointsmax_cll(n)) then
6450  write(ncpout2_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',n
6451  write(ncpout2_cll,*)
6452  endif
6453 #endif
6454  end if
6455  end if
6456  end if
6457 
6458  end subroutine tnten_list_checked_cll
6459 
6460 
6461 
6462 
6463 
6464  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6465  ! subroutine T1ten_cll(TA,TAuv,masses2,N,rmax,TAerr)
6466  !
6467  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6468 
6469  subroutine t1ten_main_cll(TA,TAuv,masses2,N,rmax,TAerr)
6470 
6471  integer, intent(in) :: rmax,N
6472  double complex,intent(in) :: masses2(0:0)
6473  double complex, intent(out) :: TA(0:rmax,0:rmax,0:rmax,0:rmax)
6474  double complex, intent(out) :: TAuv(0:rmax,0:rmax,0:rmax,0:rmax)
6475  double precision, intent(out), optional :: TAerr(0:rmax)
6476  double complex :: TA2(0:rmax,0:rmax,0:rmax,0:rmax), TAuv2(0:rmax,0:rmax,0:rmax,0:rmax)
6477  double complex :: CA(0:rmax/2), CAuv(0:rmax/2)
6478  double precision :: CAerr(0:rmax),TAerr_aux(0:rmax),TAerr_aux2(0:rmax)
6479  double complex :: args(1)
6480  double precision :: TAdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TAacc(0:rmax)
6481  integer :: r,n0,n1,n2,n3
6482  logical :: eflag
6483 
6484  if (n.ne.1) then
6485  call seterrflag_cll(-10)
6486  call errout_cll('TNten_cll','subroutine called with inconsistent arguments',eflag)
6487  end if
6488  if (n.gt.nmax_cll) then
6489  call seterrflag_cll(-10)
6490  call errout_cll('TNten_cll','argument N larger than Nmax_cll',eflag,.true.)
6491  write(nerrout_cll,*) 'N =',n
6492  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
6493  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= ',n
6494  call propagateerrflag_cll
6495  return
6496  end if
6497  if (rmax.gt.rmax_cll) then
6498  call seterrflag_cll(-10)
6499  call errout_cll('TNten_cll','argument rmax larger than rmax_cll',eflag,.true.)
6500  write(nerrout_cll,*) 'rmax =',rmax
6501  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
6502  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
6503  call propagateerrflag_cll
6504  return
6505  end if
6506 
6507  args(1) = masses2(0)
6508  call setmasterfname_cll('TNten_cll')
6509  call setmastern_cll(1)
6510  call setmasterr_cll(rmax)
6511  call setmasterargs_cll(1,args)
6512 
6513  call settencache_cll(tenred_cll-1)
6514 
6515  if (mode_cll.eq.3) then
6516  ! calculate tensor with coefficients from COLI
6517  mode_cll = 1
6518 ! call A_cll(CA,CAuv,masses2(0),rmax,CAerr,0)
6519  call tn_cll(ca,cauv,masses2(0:0),1,rmax,caerr,0)
6520  call calctensora(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
6521 
6522  ! calculate tensor with coefficients from DD
6523  mode_cll = 2
6524 ! call A_cll(CA,CAuv,masses2(0),rmax,CAerr,0)
6525  call tn_cll(ca,cauv,masses2(0:0),1,rmax,caerr,0)
6526  call calctensora(ta2,tauv2,taerr_aux2,ca,cauv,caerr,rmax)
6527 
6528  ! comparison --> take better result
6529  mode_cll = 3
6530  do r=0,rmax
6531  norm_coli=0d0
6532  norm_dd=0d0
6533  do n0=0,r
6534  do n1=0,r-n0
6535  do n2=0,r-n0-n1
6536  n3=r-n0-n1-n2
6537  norm_coli = max(norm_coli,abs(ta(n0,n1,n2,n3)))
6538  norm_dd = max(norm_dd,abs(ta2(n0,n1,n2,n3)))
6539  end do
6540  end do
6541  end do
6542  if (norm_coli.eq.0d0) then
6543  norm_coli = abs(masses2(0))
6544  if(norm_coli.ne.0d0) then
6545  norm_coli=norm_coli**(1+real(r)/2)
6546  else
6547  norm_coli=muuv2_cll**(1+real(r)/2)
6548  end if
6549  end if
6550  if (norm_dd.eq.0d0) then
6551  norm_dd = abs(masses2(0))
6552  if(norm_dd.ne.0d0) then
6553  norm_dd=norm_dd**(1+real(r)/2)
6554  else
6555  norm_dd=muuv2_cll**(1+real(r)/2)
6556  end if
6557  end if
6558  norm(r) = min(norm_coli,norm_dd)
6559  end do
6560 
6561  call checktena_cll(ta,ta2,masses2,norm,rmax,tadiff)
6562 ! call CheckTensors_cll(TA,TA2,masses2,norm,1,rmax,TAdiff)
6563 
6564  if (taerr_aux(rmax).lt.taerr_aux2(rmax)) then
6565  if (present(taerr)) taerr = max(taerr_aux,tadiff*norm)
6566  do r=0,rmax
6567  taacc(r) = max(taerr_aux(r)/norm(r),tadiff(r))
6568  end do
6569  pointscnttnten_coli(1) = pointscnttnten_coli(1) + 1
6570  else
6571  ta = ta2
6572  tauv = tauv2
6573  if (present(taerr)) taerr = max(taerr_aux2,tadiff*norm)
6574  do r=0,rmax
6575  taacc(r) = max(taerr_aux2(r)/norm(r),tadiff(r))
6576  end do
6577  pointscnttnten_dd(1) = pointscnttnten_dd(1) + 1
6578  end if
6579 
6580  else
6581 ! call A_cll(CA,CAuv,masses2(0),rmax,CAerr,0)
6582  call tn_cll(ca,cauv,masses2(0:0),1,rmax,caerr,0)
6583  call calctensora(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
6584  if (present(taerr)) taerr = taerr_aux
6585  do r=0,rmax
6586  norm(r)=0d0
6587  do n0=0,r
6588  do n1=0,r-n0
6589  do n2=0,r-n0-n1
6590  n3=r-n0-n1-n2
6591  norm(r) = max(norm(r),abs(ta(n0,n1,n2,n3)))
6592  end do
6593  end do
6594  end do
6595  if (norm(r).eq.0d0) then
6596  norm(r) = abs(masses2(0))
6597  if(norm(r).ne.0d0) then
6598  norm(r)=norm(r)**(1+real(r)/2)
6599  else
6600  norm(r)=muuv2_cll**(1+real(r)/2)
6601  end if
6602  end if
6603  end do
6604  do r=0,rmax
6605  taacc(r) = taerr_aux(r)/norm(r)
6606  end do
6607 
6608  end if
6609 
6610  call propagateaccflag_cll(taacc,rmax)
6611  call propagateerrflag_cll
6612 
6613  if (monitoring) then
6614  pointscnttnten_cll(1) = pointscnttnten_cll(1) + 1
6615 
6616  if(maxval(taacc).gt.reqacc_cll) accpointscnttnten_cll(1) = accpointscnttnten_cll(1) + 1
6617 
6618  if(maxval(taacc).gt.critacc_cll) then
6619  critpointscnttnten_cll(1) = critpointscnttnten_cll(1) + 1
6620  if ( critpointscnttnten_cll(1).le.noutcritpointsmax_cll(1) ) then
6621  call critpointsout_cll('TNten_cll',1,maxval(taacc),critpointscnttnten_cll(1))
6622  if( critpointscnttnten_cll(1).eq.noutcritpointsmax_cll(1)) then
6623  write(ncpout_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',1
6624  write(ncpout_cll,*)
6625  endif
6626 #ifdef CritPoints2
6627  call critpointsout2_cll('TNten_cll',1,maxval(taacc),critpointscnttnten_cll(1))
6628  if( critpointscnttnten_cll(1).eq.noutcritpointsmax_cll(1)) then
6629  write(ncpout2_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',1
6630  write(ncpout2_cll,*)
6631  endif
6632 #endif
6633  end if
6634  end if
6635  end if
6636 
6637  end subroutine t1ten_main_cll
6638 
6639 
6640 
6641 
6642 
6643  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6644  ! subroutine T1ten_cll(TA,TAuv,masses2,N,rmax,TAerr)
6645  !
6646  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6647 
6648  subroutine t1ten_list_cll(TA,TAuv,masses2,N,rmax,TAerr)
6649 
6650  integer, intent(in) :: rmax,N
6651  double complex,intent(in) :: masses2(0:0)
6652  double complex, intent(out) :: TA(:),TAuv(:)
6653  double precision, intent(out), optional :: TAerr(0:rmax)
6654  integer :: r,i
6655  logical :: eflag
6656 
6657  if (n.ne.1) then
6658  call seterrflag_cll(-10)
6659  call errout_cll('TNten_cll','subroutine called with inconsistent arguments',eflag)
6660  end if
6661  if (n.gt.nmax_cll) then
6662  call seterrflag_cll(-10)
6663  call errout_cll('TNten_cll','argument N larger than Nmax_cll',eflag,.true.)
6664  write(nerrout_cll,*) 'N =',n
6665  write(nerrout_cll,*) 'Nmax_cll =',nmax_cll
6666  write(nerrout_cll,*) 'Reinitialize COLLIER with Nmax_cll >= ',n
6667  call propagateerrflag_cll
6668  return
6669  end if
6670  if (rmax.gt.rmax_cll) then
6671  call seterrflag_cll(-10)
6672  call errout_cll('TNten_cll','argument rmax larger than rmax_cll',eflag,.true.)
6673  write(nerrout_cll,*) 'rmax =',rmax
6674  write(nerrout_cll,*) 'rmax_cll =',rmax_cll
6675  write(nerrout_cll,*) 'Reinitialize COLLIER with rmax_cll >= ',rmax
6676  call propagateerrflag_cll
6677  return
6678  end if
6679 
6680  call t1ten_list_checked_cll(ta,tauv,masses2,n,rmax,taerr)
6681 
6682  end subroutine t1ten_list_cll
6683 
6684 
6685  subroutine t1ten_list_checked_cll(TA,TAuv,masses2,N,rmax,TAerr)
6686 
6687  integer, intent(in) :: rmax,N
6688  double complex,intent(in) :: masses2(0:0)
6689  double complex, intent(out) :: TA(RtS(rmax)),TAuv(RtS(rmax))
6690  double precision, intent(out), optional :: TAerr(0:rmax)
6691  double complex :: TA2(RtS(rmax)),TAuv2(RtS(rmax))
6692  double complex :: CA(0:rmax/2), CAuv(0:rmax/2)
6693  double precision :: CAerr(0:rmax), TAerr_aux(0:rmax), TAerr_aux2(0:rmax)
6694  double complex :: args(1)
6695  double precision :: TAdiff(0:rmax),norm(0:rmax),norm_coli,norm_dd,TAacc(0:rmax)
6696  integer :: r,i
6697  logical :: eflag
6698 
6699  args(1) = masses2(0)
6700  call setmasterfname_cll('TNten_cll')
6701  call setmastern_cll(1)
6702  call setmasterr_cll(rmax)
6703  call setmasterargs_cll(1,args)
6704 
6705  call settencache_cll(tenred_cll-1)
6706 
6707  if (mode_cll.eq.3) then
6708  ! calculate tensor with coefficients from COLI
6709  mode_cll = 1
6710 ! call A_cll(CA,CAuv,masses2(0),rmax,CAerr,0)
6711  call tn_cll(ca,cauv,masses2(0:0),1,rmax,caerr,0)
6712  call calctensora_list(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
6713 
6714  ! calculate tensor with coefficients from DD
6715  mode_cll = 2
6716 ! call A_cll(CA,CAuv,masses2(0),rmax,CAerr,0)
6717  call tn_cll(ca,cauv,masses2(0:0),1,rmax,caerr,0)
6718  call calctensora_list(ta2,tauv2,taerr_aux2,ca,cauv,caerr,rmax)
6719 
6720  ! comparison --> take better result
6721  mode_cll = 3
6722  do r=0,rmax
6723  norm_coli=0d0
6724  norm_dd=0d0
6725  do i=rts(r-1)+1,rts(r)
6726  norm_coli = max(norm_coli,abs(ta(i)))
6727  norm_dd = max(norm_dd,abs(ta2(i)))
6728  end do
6729  if (norm_coli.eq.0d0) then
6730  norm_coli = abs(masses2(0))
6731  if(norm_coli.ne.0d0) then
6732  norm_coli=norm_coli**(1+real(r)/2)
6733  else
6734  norm_coli=muuv2_cll**(1+real(r)/2)
6735  end if
6736  end if
6737  if (norm_dd.eq.0d0) then
6738  norm_dd = abs(masses2(0))
6739  if(norm_dd.ne.0d0) then
6740  norm_dd=norm_dd**(1+real(r)/2)
6741  else
6742  norm_dd=muuv2_cll**(1+real(r)/2)
6743  end if
6744  end if
6745  norm(r) = min(norm_coli,norm_dd)
6746  end do
6747 
6748  call checktenalist_cll(ta,ta2,masses2,norm,rmax,tadiff)
6749 
6750  if (taerr_aux(rmax).lt.taerr_aux2(rmax)) then
6751  if (present(taerr)) taerr = max(taerr_aux,tadiff*norm)
6752  do r=0,rmax
6753  taacc(r) = max(taerr_aux(r)/norm(r),tadiff(r))
6754  end do
6755  if (monitoring) pointscnttnten_coli(1) = pointscnttnten_coli(1) + 1
6756  else
6757  ta = ta2
6758  tauv = tauv2
6759  if (present(taerr)) taerr = max(taerr_aux2,tadiff*norm)
6760  do r=0,rmax
6761  taacc(r) = max(taerr_aux2(r)/norm(r),tadiff(r))
6762  end do
6763  if (monitoring) pointscnttnten_dd(1) = pointscnttnten_dd(1) + 1
6764  end if
6765 
6766  else
6767 ! call A_cll(CA,CAuv,masses2(0),rmax,CAerr,0)
6768  call tn_cll(ca,cauv,masses2(0:0),1,rmax,caerr,0)
6769  call calctensora_list(ta,tauv,taerr_aux,ca,cauv,caerr,rmax)
6770  if (present(taerr)) taerr = taerr_aux
6771  do r=0,rmax
6772  norm(r)=0d0
6773  do i=rts(r-1)+1,rts(r)
6774  norm(r) = max(norm(r),abs(ta(i)))
6775  end do
6776  if (norm(r).eq.0d0) then
6777  norm(r) = abs(masses2(0))
6778  if(norm(r).ne.0d0) then
6779  norm(r)=norm(r)**(1+real(r)/2)
6780  else
6781  norm(r)=muuv2_cll**(1+real(r)/2)
6782  end if
6783  end if
6784  end do
6785  do r=0,rmax
6786  taacc(r) = taerr_aux(r)/norm(r)
6787  end do
6788 
6789  end if
6790 
6791  call propagateaccflag_cll(taacc,rmax)
6792  call propagateerrflag_cll
6793 
6794  if (monitoring) then
6795  pointscnttnten_cll(1) = pointscnttnten_cll(1) + 1
6796 
6797  if(maxval(taacc).gt.reqacc_cll) accpointscnttnten_cll(1) = accpointscnttnten_cll(1) + 1
6798 
6799  if(maxval(taacc).gt.critacc_cll) then
6800  critpointscnttnten_cll(1) = critpointscnttnten_cll(1) + 1
6801  if ( critpointscnttnten_cll(1).le.noutcritpointsmax_cll(1) ) then
6802  call critpointsout_cll('TNten_cll',1,maxval(taacc),critpointscnttnten_cll(1))
6803  if( critpointscnttnten_cll(1).eq.noutcritpointsmax_cll(1)) then
6804  write(ncpout_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',1
6805  write(ncpout_cll,*)
6806  endif
6807 #ifdef CritPoints2
6808  call critpointsout2_cll('TNten_cll',1,maxval(taacc),critpointscnttnten_cll(1))
6809  if( critpointscnttnten_cll(1).eq.noutcritpointsmax_cll(1)) then
6810  write(ncpout2_cll,*) ' Further output of Critical Points for TNten_cll suppressed for N =',1
6811  write(ncpout2_cll,*)
6812  endif
6813 #endif
6814  end if
6815  end if
6816  end if
6817 
6818  end subroutine t1ten_list_checked_cll
6819 
6820 
6821 
6822 
6823 end module collier_tensors
6824 
collier_tensors::eten_main_cll
subroutine eten_main_cll(TE, TEuv, MomVec, MomInv, masses2, rmax, TEerr)
Definition: collier_tensors.F90:2974
collier_coefs::a_cll
subroutine a_cll(A, Auv, m02, rmax, Aerr, id_in)
Definition: collier_coefs.F90:142
collier_tensors::gten_args_cll
subroutine gten_args_cll(TG, TGuv, p1vec, p2vec, p3vec, p4vec, p5vec, p6vec, 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, TGerr)
Definition: collier_tensors.F90:5371
collier_tensors::dten_list_cll
subroutine dten_list_cll(TD, TDuv, MomVec, MomInv, masses2, rmax, TDerr)
Definition: collier_tensors.F90:2400
collier_global::pointscntgten_cll
integer pointscntgten_cll
Definition: collier_global.F90:59
collier_tensors::ften_list_checked_cll
subroutine ften_list_checked_cll(TF, TFuv, MomVec, MomInv, masses2, rmax, TFerr)
Definition: collier_tensors.F90:4080
collier_tensors::aten_args_cll
subroutine aten_args_cll(TA, TAuv, m02, rmax, TAerr)
Definition: collier_tensors.F90:446
collier_tensors::dten_args_list_cll
subroutine dten_args_list_cll(TD, TDuv, p1vec, p2vec, p3vec, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, TDerr)
Definition: collier_tensors.F90:2777
buildtensors::calctensorf_list
subroutine calctensorf_list(TF, TFuv, TFerr, CoefsF, CoefsFuv, CoefsFerr, MomVec, rmax)
Definition: BuildTensors.F90:843
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
buildtensors::calctensore_list
subroutine calctensore_list(TE, TEuv, TEerr, CoefsE, CoefsEuv, CoefsEerr, MomVec, rmax)
Definition: BuildTensors.F90:643
collier_init
Definition: collier_init.F90:26
collier_global::pointscntdten_dd
integer pointscntdten_dd
Definition: collier_global.F90:85
collier_tensors::ften_args_list_checked_cll
subroutine ften_args_list_checked_cll(TF, TFuv, p1vec, p2vec, p3vec, p4vec, p5vec, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, TFerr)
Definition: collier_tensors.F90:4675
collier_tensors::cten_args_list_checked_cll
subroutine cten_args_list_checked_cll(TC, TCuv, p1vec, p2vec, p10, p21, p20, m02, m12, m22, rmax, TCerr)
Definition: collier_tensors.F90:2064
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_tensors::gten_list_checked_cll
subroutine gten_list_checked_cll(TG, TGuv, MomVec, MomInv, masses2, rmax, TGerr)
Definition: collier_tensors.F90:5199
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_tensors::ften_list_cll
subroutine ften_list_cll(TF, TFuv, MomVec, MomInv, masses2, rmax, TFerr)
Definition: collier_tensors.F90:4049
collier_tensors::bten_main_cll
subroutine bten_main_cll(TB, TBuv, MomVec, MomInv, masses2, rmax, TBerr)
Definition: collier_tensors.F90:791
collier_global::critpointscntgten_cll
integer critpointscntgten_cll
Definition: collier_global.F90:53
collier_global::pointscntgten_coli
integer pointscntgten_coli
Definition: collier_global.F90:79
collier_tensors::dten_args_cll
subroutine dten_args_cll(TD, TDuv, p1vec, p2vec, p3vec, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, TDerr)
Definition: collier_tensors.F90:2580
collier_global::pointscntbten_cll
integer pointscntbten_cll
Definition: collier_global.F90:59
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_global::accpointscntgten_cll
integer accpointscntgten_cll
Definition: collier_global.F90:56
collier_tensors::eten_args_cll
subroutine eten_args_cll(TE, TEuv, p1vec, p2vec, p3vec, p4vec, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, TEerr)
Definition: collier_tensors.F90:3341
buildtensors::calctensorc
subroutine calctensorc(TC, TCuv, TCerr, CoefsC, CoefsCuv, CoefsCerr, MomVec, rmax)
Definition: BuildTensors.F90:413
collier_tensors::tnten_main_checked_cll
subroutine tnten_main_checked_cll(TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
Definition: collier_tensors.F90:5917
collier_tensors::cten_list_checked_cll
subroutine cten_list_checked_cll(TC, TCuv, MomVec, MomInv, masses2, rmax, TCerr)
Definition: collier_tensors.F90:1700
collier_global::pointscntbten_coli
integer pointscntbten_coli
Definition: collier_global.F90:79
buildtensors
Definition: BuildTensors.F90:25
collier_tensors::dten_args_list_checked_cll
subroutine dten_args_list_checked_cll(TD, TDuv, p1vec, p2vec, p3vec, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, TDerr)
Definition: collier_tensors.F90:2810
collier_tensors::cten_main_cll
subroutine cten_main_cll(TC, TCuv, MomVec, MomInv, masses2, rmax, TCerr)
Definition: collier_tensors.F90:1494
collier_global::critpointscntdten_cll
integer critpointscntdten_cll
Definition: collier_global.F90:53
buildtensors::calctensorc_list
subroutine calctensorc_list(TC, TCuv, TCerr, CoefsC, CoefsCuv, CoefsCerr, MomVec, rmax)
Definition: BuildTensors.F90:265
collier_tensors::t1ten_list_checked_cll
subroutine t1ten_list_checked_cll(TA, TAuv, masses2, N, rmax, TAerr)
Definition: collier_tensors.F90:6686
collier_global
Definition: collier_global.F90:23
collier_tensors::gten_args_list_cll
subroutine gten_args_list_cll(TG, TGuv, p1vec, p2vec, p3vec, p4vec, p5vec, p6vec, 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, TGerr)
Definition: collier_tensors.F90:5616
collier_coefs::b_main_cll
subroutine b_main_cll(B, Buv, p10, m02, m12, rmax, Berr, id_in)
Definition: collier_coefs.F90:327
collier_tensors::dten_main_cll
subroutine dten_main_cll(TD, TDuv, MomVec, MomInv, masses2, rmax, TDerr)
Definition: collier_tensors.F90:2222
collier_global::noutcritpointsmax_cll
integer, dimension(:), allocatable noutcritpointsmax_cll
Definition: collier_global.F90:97
collier_global::accpointscntdten_cll
integer accpointscntdten_cll
Definition: collier_global.F90:56
collier_global::pointscnttnten_coli
integer, dimension(:), allocatable pointscnttnten_coli
Definition: collier_global.F90:81
collier_global::pointscntgten_dd
integer pointscntgten_dd
Definition: collier_global.F90:85
collier_global::pointscntcten_cll
integer pointscntcten_cll
Definition: collier_global.F90:59
collier_global::muir2_cll
double precision muir2_cll
Definition: collier_global.F90:28
collier_tensors::aten_list_cll
subroutine aten_list_cll(TA, TAuv, masses2, rmax, TAerr)
Definition: collier_tensors.F90:274
collier_aux::errout_cll
subroutine errout_cll(sub, err, flag, nomaster)
Definition: collier_aux.F90:1555
buildtensors::calctensore
subroutine calctensore(TE, TEuv, TEerr, CoefsE, CoefsEuv, CoefsEerr, MomVec, rmax)
Definition: BuildTensors.F90:804
collier_tensors::cten_list_cll
subroutine cten_list_cll(TC, TCuv, MomVec, MomInv, masses2, rmax, TCerr)
Definition: collier_tensors.F90:1669
collier_tensors::bten_args_cll
subroutine bten_args_cll(TB, TBuv, p1vec, p10, m02, m12, rmax, TBerr)
Definition: collier_tensors.F90:1136
collier_tensors::eten_list_cll
subroutine eten_list_cll(TE, TEuv, MomVec, MomInv, masses2, rmax, TEerr)
Definition: collier_tensors.F90:3155
collier_tensors::ften_args_list_cll
subroutine ften_args_list_cll(TF, TFuv, p1vec, p2vec, p3vec, p4vec, p5vec, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, TFerr)
Definition: collier_tensors.F90:4638
collier_tensors::aten_args_list_checked_cll
subroutine aten_args_list_checked_cll(TA, TAuv, m02, rmax, TAerr)
Definition: collier_tensors.F90:649
buildtensors::calctensord_list
subroutine calctensord_list(TD, TDuv, TDerr, CoefsD, CoefsDuv, CoefsDerr, MomVec, rmax)
Definition: BuildTensors.F90:452
collier_tensors::aten_args_list_cll
subroutine aten_args_list_cll(TA, TAuv, m02, rmax, TAerr)
Definition: collier_tensors.F90:617
collier_global::pointscnteten_dd
integer pointscnteten_dd
Definition: collier_global.F90:85
collier_tensors::eten_args_list_checked_cll
subroutine eten_args_list_checked_cll(TE, TEuv, p1vec, p2vec, p3vec, p4vec, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, TEerr)
Definition: collier_tensors.F90:3592
collier_tensors::tnten_main_cll
subroutine tnten_main_cll(TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
Definition: collier_tensors.F90:5877
collier_tensors::eten_args_list_cll
subroutine eten_args_list_cll(TE, TEuv, p1vec, p2vec, p3vec, p4vec, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, TEerr)
Definition: collier_tensors.F90:3548
collier_coefs::tn_cll
Definition: collier_coefs.F90:76
collier_global::pointscnteten_cll
integer pointscnteten_cll
Definition: collier_global.F90:59
collier_global::reqacc_cll
double precision reqacc_cll
Definition: collier_global.F90:30
collier_global::accpointscntbten_cll
integer accpointscntbten_cll
Definition: collier_global.F90:56
tensorreduction::calctensortnr
recursive subroutine calctensortnr(TN, TNuv, TNerr, MomVec, MomInv, masses2, N, rmax, id, CNuv)
Definition: TensorReduction.F90:617
collier_tensors::gten_cll
Definition: collier_tensors.F90:80
buildtensors::calctensorb
subroutine calctensorb(TB, TBuv, TBerr, CoefsB, CoefsBuv, CoefsBerr, mom, rmax)
Definition: BuildTensors.F90:229
collier_global::tenred_cll
integer tenred_cll
Definition: collier_global.F90:40
collier_global::pointscntften_dd
integer pointscntften_dd
Definition: collier_global.F90:85
collier_global::ncpout2_cll
integer ncpout2_cll
Definition: collier_global.F90:103
collier_tensors::t1ten_list_cll
subroutine t1ten_list_cll(TA, TAuv, masses2, N, rmax, TAerr)
Definition: collier_tensors.F90:6649
collier_global::ncpout_cll
integer ncpout_cll
Definition: collier_global.F90:103
collier_tensors::tnten_list_checked_cll
subroutine tnten_list_checked_cll(TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
Definition: collier_tensors.F90:6223
collier_tensors::t1ten_main_cll
subroutine t1ten_main_cll(TA, TAuv, masses2, N, rmax, TAerr)
Definition: collier_tensors.F90:6470
collier_tensors::dten_cll
Definition: collier_tensors.F90:62
collier_tensors::aten_cll
Definition: collier_tensors.F90:44
collier_tensors::bten_cll
Definition: collier_tensors.F90:50
buildtensors::calctensorb_list
subroutine calctensorb_list(TB, TBuv, TBerr, CoefsB, CoefsBuv, CoefsBerr, mom, rmax)
Definition: BuildTensors.F90:123
collier_tensors::dten_list_checked_cll
subroutine dten_list_checked_cll(TD, TDuv, MomVec, MomInv, masses2, rmax, TDerr)
Definition: collier_tensors.F90:2431
collier_tensors::eten_cll
Definition: collier_tensors.F90:68
collier_tensors::ften_cll
Definition: collier_tensors.F90:74
collier_tensors::cten_cll
Definition: collier_tensors.F90:56
collier_tensors::cten_args_cll
subroutine cten_args_cll(TC, TCuv, p1vec, p2vec, p10, p21, p20, m02, m12, m22, rmax, TCerr)
Definition: collier_tensors.F90:1846
collier_global::pointscntdten_coli
integer pointscntdten_coli
Definition: collier_global.F90:79
collier_global::accpointscntcten_cll
integer accpointscntcten_cll
Definition: collier_global.F90:56
collier_global::critpointscntften_cll
integer critpointscntften_cll
Definition: collier_global.F90:53
collier_global::pointscnttnten_dd
integer, dimension(:), allocatable pointscnttnten_dd
Definition: collier_global.F90:87
collier_global::pointscnteten_coli
integer pointscnteten_coli
Definition: collier_global.F90:79
buildtensors::calctensord
subroutine calctensord(TD, TDuv, TDerr, CoefsD, CoefsDuv, CoefsDerr, MomVec, rmax)
Definition: BuildTensors.F90:605
collier_tensors::gten_list_cll
subroutine gten_list_cll(TG, TGuv, MomVec, MomInv, masses2, rmax, TGerr)
Definition: collier_tensors.F90:5168
collier_global::monitoring
logical monitoring
Definition: collier_global.F90:64
collier_global::mode_cll
integer mode_cll
Definition: collier_global.F90:27
collier_global::critpointscntaten_cll
integer critpointscntaten_cll
Definition: collier_global.F90:53
collier_global::pointscntcten_dd
integer pointscntcten_dd
Definition: collier_global.F90:85
collier_tensors::ften_main_cll
subroutine ften_main_cll(TF, TFuv, MomVec, MomInv, masses2, rmax, TFerr)
Definition: collier_tensors.F90:3768
collier_init::propagateaccflag_cll
subroutine propagateaccflag_cll(RelErrs, rmax)
Definition: collier_init.F90:2450
collier_global::pointscntaten_coli
integer pointscntaten_coli
Definition: collier_global.F90:79
buildtensors::calctensora
subroutine calctensora(TA, TAuv, TAerr, CoefsA, CoefsAuv, CoefsAerr, rmax)
Definition: BuildTensors.F90:89
collier_global::pointscntcten_coli
integer pointscntcten_coli
Definition: collier_global.F90:79
collier_global::critpointscnteten_cll
integer critpointscnteten_cll
Definition: collier_global.F90:53
collier_global::accpointscntaten_cll
integer accpointscntaten_cll
Definition: collier_global.F90:56
collier_tensors::aten_main_cll
subroutine aten_main_cll(TA, TAuv, masses2, rmax, TAerr)
Definition: collier_tensors.F90:104
collier_global::pointscntdten_cll
integer pointscntdten_cll
Definition: collier_global.F90:59
collier_tensors::bten_args_list_checked_cll
subroutine bten_args_list_checked_cll(TB, TBuv, p1vec, p10, m02, m12, rmax, TBerr)
Definition: collier_tensors.F90:1346
tensorreduction
Definition: TensorReduction.F90:25
buildtensors::calctensora_list
subroutine calctensora_list(TA, TAuv, TAerr, CoefsA, CoefsAuv, CoefsAerr, rmax)
Definition: BuildTensors.F90:43
collier_tensors::bten_list_checked_cll
subroutine bten_list_checked_cll(TB, TBuv, MomVec, MomInv, masses2, rmax, TBerr)
Definition: collier_tensors.F90:994
tensorreduction::calctensorfr_list
subroutine calctensorfr_list(TF, TFuv, TFerr, MomVec, MomInv, masses2, rmax)
Definition: TensorReduction.F90:584
collier_global::pointscntaten_cll
integer pointscntaten_cll
Definition: collier_global.F90:59
collier_tensors::ften_args_cll
subroutine ften_args_cll(TF, TFuv, p1vec, p2vec, p3vec, p4vec, p5vec, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, TFerr)
Definition: collier_tensors.F90:4325
collier_global::accpointscntften_cll
integer accpointscntften_cll
Definition: collier_global.F90:56
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_tensors::gten_args_list_checked_cll
subroutine gten_args_list_checked_cll(TG, TGuv, p1vec, p2vec, p3vec, p4vec, p5vec, p6vec, 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, TGerr)
Definition: collier_tensors.F90:5665
collier_global::critacc_cll
double precision critacc_cll
Definition: collier_global.F90:30
collier_global::pointscntften_cll
integer pointscntften_cll
Definition: collier_global.F90:59
collier_init::seterrflag_cll
subroutine seterrflag_cll(val)
Definition: collier_init.F90:2158
collier_tensors
Definition: collier_tensors.F90:28
buildtensors::calctensortn_list
subroutine calctensortn_list(TN, TNuv, TNerr, CoefsN, CoefsNuv, CoefsNerr, MomVec, N, rmax)
Definition: BuildTensors.F90:1383
collier_global::accpointscnteten_cll
integer accpointscnteten_cll
Definition: collier_global.F90:56
buildtensors::calctensorg
subroutine calctensorg(TG, TGuv, TGerr, CoefsG, CoefsGuv, CoefsGerr, MomVec, rmax)
Definition: BuildTensors.F90:1344
collier_tensors::aten_list_checked_cll
subroutine aten_list_checked_cll(TA, TAuv, masses2, rmax, TAerr)
Definition: collier_tensors.F90:306
collier_global::pointscntaten_dd
integer pointscntaten_dd
Definition: collier_global.F90:85
collier_global::critpointscntbten_cll
integer critpointscntbten_cll
Definition: collier_global.F90:53
collier_tensors::gten_main_cll
subroutine gten_main_cll(TG, TGuv, MomVec, MomInv, masses2, rmax, TGerr)
Definition: collier_tensors.F90:4945
collier_global::accpointscnttnten_cll
integer, dimension(:), allocatable accpointscnttnten_cll
Definition: collier_global.F90:62
buildtensors::calctensorg_list
subroutine calctensorg_list(TG, TGuv, TGerr, CoefsG, CoefsGuv, CoefsGerr, MomVec, rmax)
Definition: BuildTensors.F90:1178
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
tensorreduction::calctensorfr
subroutine calctensorfr(TF, TFuv, TFerr, MomVec, MomInv, masses2, rmax)
Definition: TensorReduction.F90:45
collier_global::critpointscnttnten_cll
integer, dimension(:), allocatable critpointscnttnten_cll
Definition: collier_global.F90:62
collier_tensors::cten_args_list_cll
subroutine cten_args_list_cll(TC, TCuv, p1vec, p2vec, p10, p21, p20, m02, m12, m22, rmax, TCerr)
Definition: collier_tensors.F90:2033
collier_global::pointscnttnten_cll
integer, dimension(:), allocatable pointscnttnten_cll
Definition: collier_global.F90:62
collier_tensors::eten_list_checked_cll
subroutine eten_list_checked_cll(TE, TEuv, MomVec, MomInv, masses2, rmax, TEerr)
Definition: collier_tensors.F90:3187
collier_tensors::tnten_list_cll
subroutine tnten_list_cll(TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
Definition: collier_tensors.F90:6184
collier_global::critpointscntcten_cll
integer critpointscntcten_cll
Definition: collier_global.F90:53
collier_init::propagateerrflag_cll
subroutine propagateerrflag_cll()
Definition: collier_init.F90:2194
buildtensors::calctensortn
subroutine calctensortn(TN, TNuv, TNerr, CoefsN, CoefsNuv, CoefsNerr, MomVec, N, rmax)
Definition: BuildTensors.F90:1546
collier_aux::critpointsout2_cll
subroutine critpointsout2_cll(sub, N, acc, cntr)
Definition: collier_aux.F90:1650
collier_global::pointscntften_coli
integer pointscntften_coli
Definition: collier_global.F90:79
collier_tensors::bten_list_cll
subroutine bten_list_cll(TB, TBuv, MomVec, MomInv, masses2, rmax, TBerr)
Definition: collier_tensors.F90:962
tensorreduction::calctensortnr_list
subroutine calctensortnr_list(TN, TNuv, TNerr, MomVec, MomInv, masses2, N, rmax)
Definition: TensorReduction.F90:1264
collier_tensors::bten_args_list_cll
subroutine bten_args_list_cll(TB, TBuv, p1vec, p10, m02, m12, rmax, TBerr)
Definition: collier_tensors.F90:1313
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_global::pointscntbten_dd
integer pointscntbten_dd
Definition: collier_global.F90:85
collier_global::rmax_cll
integer rmax_cll
Definition: collier_global.F90:44
buildtensors::calctensorf
subroutine calctensorf(TF, TFuv, TFerr, CoefsF, CoefsFuv, CoefsFerr, MomVec, rmax)
Definition: BuildTensors.F90:1004
collier_tensors::tnten_cll
Definition: collier_tensors.F90:86