JHUGen MELA  v2.4.1
Matrix element calculations as used in JHUGen. MELA is an important tool that was used for the Higgs boson discovery and for precise measurements of its structure and interactions. Please see the website https://spin.pha.jhu.edu/ and papers cited there for more details, and kindly cite those papers when using this code.
Data Types | Functions/Subroutines
collier_tensors Module Reference

Data Types

interface  aten_cll
 
interface  bten_cll
 
interface  cten_cll
 
interface  dten_cll
 
interface  eten_cll
 
interface  ften_cll
 
interface  gten_cll
 
interface  tnten_cll
 

Functions/Subroutines

subroutine aten_main_cll (TA, TAuv, masses2, rmax, TAerr)
 
subroutine aten_list_cll (TA, TAuv, masses2, rmax, TAerr)
 
subroutine aten_list_checked_cll (TA, TAuv, masses2, rmax, TAerr)
 
subroutine aten_args_cll (TA, TAuv, m02, rmax, TAerr)
 
subroutine aten_args_list_cll (TA, TAuv, m02, rmax, TAerr)
 
subroutine aten_args_list_checked_cll (TA, TAuv, m02, rmax, TAerr)
 
subroutine bten_main_cll (TB, TBuv, MomVec, MomInv, masses2, rmax, TBerr)
 
subroutine bten_list_cll (TB, TBuv, MomVec, MomInv, masses2, rmax, TBerr)
 
subroutine bten_list_checked_cll (TB, TBuv, MomVec, MomInv, masses2, rmax, TBerr)
 
subroutine bten_args_cll (TB, TBuv, p1vec, p10, m02, m12, rmax, TBerr)
 
subroutine bten_args_list_cll (TB, TBuv, p1vec, p10, m02, m12, rmax, TBerr)
 
subroutine bten_args_list_checked_cll (TB, TBuv, p1vec, p10, m02, m12, rmax, TBerr)
 
subroutine cten_main_cll (TC, TCuv, MomVec, MomInv, masses2, rmax, TCerr)
 
subroutine cten_list_cll (TC, TCuv, MomVec, MomInv, masses2, rmax, TCerr)
 
subroutine cten_list_checked_cll (TC, TCuv, MomVec, MomInv, masses2, rmax, TCerr)
 
subroutine cten_args_cll (TC, TCuv, p1vec, p2vec, p10, p21, p20, m02, m12, m22, rmax, TCerr)
 
subroutine cten_args_list_cll (TC, TCuv, p1vec, p2vec, p10, p21, p20, m02, m12, m22, rmax, TCerr)
 
subroutine cten_args_list_checked_cll (TC, TCuv, p1vec, p2vec, p10, p21, p20, m02, m12, m22, rmax, TCerr)
 
subroutine dten_main_cll (TD, TDuv, MomVec, MomInv, masses2, rmax, TDerr)
 
subroutine dten_list_cll (TD, TDuv, MomVec, MomInv, masses2, rmax, TDerr)
 
subroutine dten_list_checked_cll (TD, TDuv, MomVec, MomInv, masses2, rmax, TDerr)
 
subroutine dten_args_cll (TD, TDuv, p1vec, p2vec, p3vec, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, TDerr)
 
subroutine dten_args_list_cll (TD, TDuv, p1vec, p2vec, p3vec, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, TDerr)
 
subroutine dten_args_list_checked_cll (TD, TDuv, p1vec, p2vec, p3vec, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, TDerr)
 
subroutine eten_main_cll (TE, TEuv, MomVec, MomInv, masses2, rmax, TEerr)
 
subroutine eten_list_cll (TE, TEuv, MomVec, MomInv, masses2, rmax, TEerr)
 
subroutine eten_list_checked_cll (TE, TEuv, MomVec, MomInv, masses2, rmax, TEerr)
 
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)
 
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)
 
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)
 
subroutine ften_main_cll (TF, TFuv, MomVec, MomInv, masses2, rmax, TFerr)
 
subroutine ften_list_cll (TF, TFuv, MomVec, MomInv, masses2, rmax, TFerr)
 
subroutine ften_list_checked_cll (TF, TFuv, MomVec, MomInv, masses2, rmax, TFerr)
 
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)
 
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)
 
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)
 
subroutine gten_main_cll (TG, TGuv, MomVec, MomInv, masses2, rmax, TGerr)
 
subroutine gten_list_cll (TG, TGuv, MomVec, MomInv, masses2, rmax, TGerr)
 
subroutine gten_list_checked_cll (TG, TGuv, MomVec, MomInv, masses2, rmax, TGerr)
 
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)
 
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)
 
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)
 
subroutine tnten_main_cll (TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
 
subroutine tnten_main_checked_cll (TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
 
subroutine tnten_list_cll (TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
 
subroutine tnten_list_checked_cll (TN, TNuv, MomVec, MomInv, masses2, N, rmax, TNerr)
 
subroutine t1ten_main_cll (TA, TAuv, masses2, N, rmax, TAerr)
 
subroutine t1ten_list_cll (TA, TAuv, masses2, N, rmax, TAerr)
 
subroutine t1ten_list_checked_cll (TA, TAuv, masses2, N, rmax, TAerr)
 

Function/Subroutine Documentation

◆ aten_args_cll()

subroutine collier_tensors::aten_args_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TA,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TAuv,
double complex, intent(in)  m02,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 446 of file collier_tensors.F90.

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 

◆ aten_args_list_checked_cll()

subroutine collier_tensors::aten_args_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TA,
double complex, dimension(rts(rmax)), intent(out)  TAuv,
double complex, intent(in)  m02,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 649 of file collier_tensors.F90.

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 

◆ aten_args_list_cll()

subroutine collier_tensors::aten_args_list_cll ( double complex, dimension(:), intent(out)  TA,
double complex, dimension(:), intent(out)  TAuv,
double complex, intent(in)  m02,
integer, intent(in)  rmax,
double precision, dimension(0:), intent(out), optional  TAerr 
)

Definition at line 617 of file collier_tensors.F90.

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 

◆ aten_list_checked_cll()

subroutine collier_tensors::aten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TA,
double complex, dimension(rts(rmax)), intent(out)  TAuv,
double complex, dimension(0:0), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 306 of file collier_tensors.F90.

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 

◆ aten_list_cll()

subroutine collier_tensors::aten_list_cll ( double complex, dimension(:), intent(out)  TA,
double complex, dimension(:), intent(out)  TAuv,
double complex, dimension(0:0), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 274 of file collier_tensors.F90.

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 

◆ aten_main_cll()

subroutine collier_tensors::aten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TA,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TAuv,
double complex, dimension(0:0), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 104 of file collier_tensors.F90.

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 

◆ bten_args_cll()

subroutine collier_tensors::bten_args_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TB,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TBuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, intent(in)  p10,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TBerr 
)

Definition at line 1136 of file collier_tensors.F90.

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 

◆ bten_args_list_checked_cll()

subroutine collier_tensors::bten_args_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TB,
double complex, dimension(rts(rmax)), intent(out)  TBuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, intent(in)  p10,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TBerr 
)

Definition at line 1346 of file collier_tensors.F90.

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 

◆ bten_args_list_cll()

subroutine collier_tensors::bten_args_list_cll ( double complex, dimension(:), intent(out)  TB,
double complex, dimension(:), intent(out)  TBuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, intent(in)  p10,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TBerr 
)

Definition at line 1313 of file collier_tensors.F90.

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 

◆ bten_list_checked_cll()

subroutine collier_tensors::bten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TB,
double complex, dimension(rts(rmax)), intent(out)  TBuv,
double complex, dimension(0:3,1), intent(in)  MomVec,
double complex, dimension(1), intent(in)  MomInv,
double complex, dimension(0:1), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TBerr 
)

Definition at line 994 of file collier_tensors.F90.

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 

◆ bten_list_cll()

subroutine collier_tensors::bten_list_cll ( double complex, dimension(:), intent(out)  TB,
double complex, dimension(:), intent(out)  TBuv,
double complex, dimension(0:3,1), intent(in)  MomVec,
double complex, dimension(1), intent(in)  MomInv,
double complex, dimension(0:1), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TBerr 
)

Definition at line 962 of file collier_tensors.F90.

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 

◆ bten_main_cll()

subroutine collier_tensors::bten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TB,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TBuv,
double complex, dimension(0:3,1), intent(in)  MomVec,
double complex, dimension(1), intent(in)  MomInv,
double complex, dimension(0:1), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TBerr 
)

Definition at line 791 of file collier_tensors.F90.

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 

◆ cten_args_cll()

subroutine collier_tensors::cten_args_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TC,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TCuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p20,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TCerr 
)

Definition at line 1846 of file collier_tensors.F90.

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 

◆ cten_args_list_checked_cll()

subroutine collier_tensors::cten_args_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TC,
double complex, dimension(rts(rmax)), intent(out)  TCuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p20,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TCerr 
)

Definition at line 2064 of file collier_tensors.F90.

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 

◆ cten_args_list_cll()

subroutine collier_tensors::cten_args_list_cll ( double complex, dimension(:), intent(out)  TC,
double complex, dimension(:), intent(out)  TCuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p20,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TCerr 
)

Definition at line 2033 of file collier_tensors.F90.

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 

◆ cten_list_checked_cll()

subroutine collier_tensors::cten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TC,
double complex, dimension(rts(rmax)), intent(out)  TCuv,
double complex, dimension(0:3,2), intent(in)  MomVec,
double complex, dimension(3), intent(in)  MomInv,
double complex, dimension(0:2), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TCerr 
)

Definition at line 1700 of file collier_tensors.F90.

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 

◆ cten_list_cll()

subroutine collier_tensors::cten_list_cll ( double complex, dimension(:), intent(out)  TC,
double complex, dimension(:), intent(out)  TCuv,
double complex, dimension(0:3,2), intent(in)  MomVec,
double complex, dimension(3), intent(in)  MomInv,
double complex, dimension(0:2), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TCerr 
)

Definition at line 1669 of file collier_tensors.F90.

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 

◆ cten_main_cll()

subroutine collier_tensors::cten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TC,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TCuv,
double complex, dimension(0:3,2), intent(in)  MomVec,
double complex, dimension(3), intent(in)  MomInv,
double complex, dimension(0:2), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TCerr 
)

Definition at line 1494 of file collier_tensors.F90.

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 

◆ dten_args_cll()

subroutine collier_tensors::dten_args_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TD,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TDuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p30,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TDerr 
)

Definition at line 2580 of file collier_tensors.F90.

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 

◆ dten_args_list_checked_cll()

subroutine collier_tensors::dten_args_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TD,
double complex, dimension(rts(rmax)), intent(out)  TDuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p30,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TDerr 
)

Definition at line 2810 of file collier_tensors.F90.

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 

◆ dten_args_list_cll()

subroutine collier_tensors::dten_args_list_cll ( double complex, dimension(:), intent(out)  TD,
double complex, dimension(:), intent(out)  TDuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p30,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TDerr 
)

Definition at line 2777 of file collier_tensors.F90.

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 

◆ dten_list_checked_cll()

subroutine collier_tensors::dten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TD,
double complex, dimension(rts(rmax)), intent(out)  TDuv,
double complex, dimension(0:3,3), intent(in)  MomVec,
double complex, dimension(6), intent(in)  MomInv,
double complex, dimension(0:3), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TDerr 
)

Definition at line 2431 of file collier_tensors.F90.

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 

◆ dten_list_cll()

subroutine collier_tensors::dten_list_cll ( double complex, dimension(:), intent(out)  TD,
double complex, dimension(:), intent(out)  TDuv,
double complex, dimension(0:3,3), intent(in)  MomVec,
double complex, dimension(6), intent(in)  MomInv,
double complex, dimension(0:3), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TDerr 
)

Definition at line 2400 of file collier_tensors.F90.

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 

◆ dten_main_cll()

subroutine collier_tensors::dten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TD,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TDuv,
double complex, dimension(0:3,3), intent(in)  MomVec,
double complex, dimension(6), intent(in)  MomInv,
double complex, dimension(0:3), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TDerr 
)

Definition at line 2222 of file collier_tensors.F90.

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 

◆ eten_args_cll()

subroutine collier_tensors::eten_args_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TE,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TEuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p40,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TEerr 
)

Definition at line 3341 of file collier_tensors.F90.

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 

◆ eten_args_list_checked_cll()

subroutine collier_tensors::eten_args_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TE,
double complex, dimension(rts(rmax)), intent(out)  TEuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p40,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TEerr 
)

Definition at line 3592 of file collier_tensors.F90.

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 

◆ eten_args_list_cll()

subroutine collier_tensors::eten_args_list_cll ( double complex, dimension(rts(rmax)), intent(out)  TE,
double complex, dimension(rts(rmax)), intent(out)  TEuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p40,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TEerr 
)

Definition at line 3548 of file collier_tensors.F90.

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 

◆ eten_list_checked_cll()

subroutine collier_tensors::eten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TE,
double complex, dimension(rts(rmax)), intent(out)  TEuv,
double complex, dimension(0:3,4), intent(in)  MomVec,
double complex, dimension(10), intent(in)  MomInv,
double complex, dimension(0:4), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TEerr 
)

Definition at line 3187 of file collier_tensors.F90.

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 

◆ eten_list_cll()

subroutine collier_tensors::eten_list_cll ( double complex, dimension(:), intent(out)  TE,
double complex, dimension(:), intent(out)  TEuv,
double complex, dimension(0:3,4), intent(in)  MomVec,
double complex, dimension(10), intent(in)  MomInv,
double complex, dimension(0:4), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TEerr 
)

Definition at line 3155 of file collier_tensors.F90.

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 

◆ eten_main_cll()

subroutine collier_tensors::eten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TE,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TEuv,
double complex, dimension(0:3,4), intent(in)  MomVec,
double complex, dimension(10), intent(in)  MomInv,
double complex, dimension(0:4), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TEerr 
)

Definition at line 2974 of file collier_tensors.F90.

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 

◆ ften_args_cll()

subroutine collier_tensors::ften_args_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TF,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TFuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, dimension(0:3), intent(in)  p5vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p54,
double complex, intent(in)  p50,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p53,
double complex, intent(in)  p40,
double complex, intent(in)  p51,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  p52,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
double complex, intent(in)  m52,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TFerr 
)

Definition at line 4325 of file collier_tensors.F90.

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 

◆ ften_args_list_checked_cll()

subroutine collier_tensors::ften_args_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TF,
double complex, dimension(rts(rmax)), intent(out)  TFuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, dimension(0:3), intent(in)  p5vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p54,
double complex, intent(in)  p50,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p53,
double complex, intent(in)  p40,
double complex, intent(in)  p51,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  p52,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
double complex, intent(in)  m52,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TFerr 
)

Definition at line 4675 of file collier_tensors.F90.

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 

◆ ften_args_list_cll()

subroutine collier_tensors::ften_args_list_cll ( double complex, dimension(:), intent(out)  TF,
double complex, dimension(:), intent(out)  TFuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, dimension(0:3), intent(in)  p5vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p54,
double complex, intent(in)  p50,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p53,
double complex, intent(in)  p40,
double complex, intent(in)  p51,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  p52,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
double complex, intent(in)  m52,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TFerr 
)

Definition at line 4638 of file collier_tensors.F90.

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 

◆ ften_list_checked_cll()

subroutine collier_tensors::ften_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TF,
double complex, dimension(rts(rmax)), intent(out)  TFuv,
double complex, dimension(0:3,5), intent(in)  MomVec,
double complex, dimension(15), intent(in)  MomInv,
double complex, dimension(0:5), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TFerr 
)

Definition at line 4080 of file collier_tensors.F90.

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 

◆ ften_list_cll()

subroutine collier_tensors::ften_list_cll ( double complex, dimension(:), intent(out)  TF,
double complex, dimension(:), intent(out)  TFuv,
double complex, dimension(0:3,5), intent(in)  MomVec,
double complex, dimension(15), intent(in)  MomInv,
double complex, dimension(0:5), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TFerr 
)

Definition at line 4049 of file collier_tensors.F90.

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 

◆ ften_main_cll()

subroutine collier_tensors::ften_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TF,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TFuv,
double complex, dimension(0:3,5), intent(in)  MomVec,
double complex, dimension(15), intent(in)  MomInv,
double complex, dimension(0:5), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TFerr 
)

Definition at line 3768 of file collier_tensors.F90.

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 

◆ gten_args_cll()

subroutine collier_tensors::gten_args_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TG,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TGuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, dimension(0:3), intent(in)  p5vec,
double complex, dimension(0:3), intent(in)  p6vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p54,
double complex, intent(in)  p65,
double complex, intent(in)  p60,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p53,
double complex, intent(in)  p64,
double complex, intent(in)  p50,
double complex, intent(in)  p61,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  p52,
double complex, intent(in)  p63,
double complex, intent(in)  p40,
double complex, intent(in)  p51,
double complex, intent(in)  p62,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
double complex, intent(in)  m52,
double complex, intent(in)  m62,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TGerr 
)

Definition at line 5371 of file collier_tensors.F90.

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 

◆ gten_args_list_checked_cll()

subroutine collier_tensors::gten_args_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TG,
double complex, dimension(rts(rmax)), intent(out)  TGuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, dimension(0:3), intent(in)  p5vec,
double complex, dimension(0:3), intent(in)  p6vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p54,
double complex, intent(in)  p65,
double complex, intent(in)  p60,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p53,
double complex, intent(in)  p64,
double complex, intent(in)  p50,
double complex, intent(in)  p61,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  p52,
double complex, intent(in)  p63,
double complex, intent(in)  p40,
double complex, intent(in)  p51,
double complex, intent(in)  p62,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
double complex, intent(in)  m52,
double complex, intent(in)  m62,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TGerr 
)

Definition at line 5665 of file collier_tensors.F90.

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 

◆ gten_args_list_cll()

subroutine collier_tensors::gten_args_list_cll ( double complex, dimension(rts(rmax)), intent(out)  TG,
double complex, dimension(rts(rmax)), intent(out)  TGuv,
double complex, dimension(0:3), intent(in)  p1vec,
double complex, dimension(0:3), intent(in)  p2vec,
double complex, dimension(0:3), intent(in)  p3vec,
double complex, dimension(0:3), intent(in)  p4vec,
double complex, dimension(0:3), intent(in)  p5vec,
double complex, dimension(0:3), intent(in)  p6vec,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p54,
double complex, intent(in)  p65,
double complex, intent(in)  p60,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p53,
double complex, intent(in)  p64,
double complex, intent(in)  p50,
double complex, intent(in)  p61,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  p52,
double complex, intent(in)  p63,
double complex, intent(in)  p40,
double complex, intent(in)  p51,
double complex, intent(in)  p62,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
double complex, intent(in)  m52,
double complex, intent(in)  m62,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TGerr 
)

Definition at line 5616 of file collier_tensors.F90.

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 

◆ gten_list_checked_cll()

subroutine collier_tensors::gten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TG,
double complex, dimension(rts(rmax)), intent(out)  TGuv,
double complex, dimension(0:3,6), intent(in)  MomVec,
double complex, dimension(21), intent(in)  MomInv,
double complex, dimension(0:6), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TGerr 
)

Definition at line 5199 of file collier_tensors.F90.

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 

◆ gten_list_cll()

subroutine collier_tensors::gten_list_cll ( double complex, dimension(:), intent(out)  TG,
double complex, dimension(:), intent(out)  TGuv,
double complex, dimension(0:3,6), intent(in)  MomVec,
double complex, dimension(21), intent(in)  MomInv,
double complex, dimension(0:6), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TGerr 
)

Definition at line 5168 of file collier_tensors.F90.

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 

◆ gten_main_cll()

subroutine collier_tensors::gten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TG,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TGuv,
double complex, dimension(0:3,6), intent(in)  MomVec,
double complex, dimension(21), intent(in)  MomInv,
double complex, dimension(0:6), intent(in)  masses2,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TGerr 
)

Definition at line 4945 of file collier_tensors.F90.

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 

◆ t1ten_list_checked_cll()

subroutine collier_tensors::t1ten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TA,
double complex, dimension(rts(rmax)), intent(out)  TAuv,
double complex, dimension(0:0), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 6686 of file collier_tensors.F90.

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 

◆ t1ten_list_cll()

subroutine collier_tensors::t1ten_list_cll ( double complex, dimension(:), intent(out)  TA,
double complex, dimension(:), intent(out)  TAuv,
double complex, dimension(0:0), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 6649 of file collier_tensors.F90.

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 

◆ t1ten_main_cll()

subroutine collier_tensors::t1ten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TA,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TAuv,
double complex, dimension(0:0), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TAerr 
)

Definition at line 6470 of file collier_tensors.F90.

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 

◆ tnten_list_checked_cll()

subroutine collier_tensors::tnten_list_checked_cll ( double complex, dimension(rts(rmax)), intent(out)  TN,
double complex, dimension(rts(rmax)), intent(out)  TNuv,
double complex, dimension(0:3,max(n-1,1)), intent(in)  MomVec,
double complex, dimension(binomtable(2,n)), intent(in)  MomInv,
double complex, dimension(0:max(n-1,1)), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TNerr 
)

Definition at line 6223 of file collier_tensors.F90.

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 

◆ tnten_list_cll()

subroutine collier_tensors::tnten_list_cll ( double complex, dimension(:), intent(out)  TN,
double complex, dimension(:), intent(out)  TNuv,
double complex, dimension(0:3,max(n-1,1)), intent(in)  MomVec,
double complex, dimension(:), intent(in)  MomInv,
double complex, dimension(0:max(n-1,1)), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TNerr 
)

Definition at line 6184 of file collier_tensors.F90.

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 

◆ tnten_main_checked_cll()

subroutine collier_tensors::tnten_main_checked_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TN,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TNuv,
double complex, dimension(0:3,max(n-1,1)), intent(in)  MomVec,
double complex, dimension(binomtable(2,n)), intent(in)  MomInv,
double complex, dimension(0:max(n-1,1)), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TNerr 
)

Definition at line 5917 of file collier_tensors.F90.

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 

◆ tnten_main_cll()

subroutine collier_tensors::tnten_main_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TN,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(out)  TNuv,
double complex, dimension(0:3,max(n-1,1)), intent(in)  MomVec,
double complex, dimension(:), intent(in)  MomInv,
double complex, dimension(0:max(n-1,1)), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out), optional  TNerr 
)

Definition at line 5877 of file collier_tensors.F90.

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 
endif
O0 g endif() string(TOLOWER "$
Definition: CMakeLists.txt:143
Generated by   doxygen 1.8.17