JHUGen MELA  JHUGen v7.5.6, MELA v2.4.2
Matrix element calculations as used in JHUGen.
Functions/Subroutines | Variables
inittensors Module Reference

Functions/Subroutines

subroutine init_tables2 (Nm1, rmax)
 
subroutine setrts (rmax)
 
subroutine setlorindtab (rmax)
 
subroutine setaddindtab (rmax)
 
subroutine setaddgtab (rmax)
 
subroutine setcftab (rmax)
 
subroutine setindspiprod (Nm1max, rmax)
 
integer function, dimension(:,:,:), allocatable calcindspiprod (Nm1, r)
 
subroutine switchoffcalcuv_ten ()
 
subroutine switchoncalcuv_ten ()
 
subroutine checktensors_cll (T1, T2, MomVec, MomInv, masses2, norm, N, rmax, Tdiff)
 
subroutine checktensorslist_cll (T1, T2, MomVec, MomInv, masses2, norm, N, rmax, Tdiff)
 
subroutine checktena_cll (T1, T2, masses2, norm, rmax, Tdiff)
 
subroutine checktenalist_cll (T1, T2, masses2, norm, rmax, Tdiff)
 

Variables

integer, dimension(:,:), allocatable cftab
 
integer, dimension(:,:), allocatable lorindtab
 
integer, dimension(:,:), allocatable addindtab
 
integer, dimension(:,:), allocatable addgtab
 
integer, dimension(:,:,:,:), allocatable indspiprod
 
integer, dimension(:), allocatable rts
 
real stin
 
real stout
 
real time1
 
real time2
 
real time3
 
logical calcuv_ten
 

Function/Subroutine Documentation

◆ calcindspiprod()

integer function, dimension(:,:,:), allocatable inittensors::calcindspiprod ( integer, intent(in)  Nm1,
integer, intent(in)  r 
)

Definition at line 302 of file InitTensors.F90.

302 
303  integer, intent(in) :: Nm1, r
304  integer, dimension(:,:,:), allocatable :: IndsPiProd
305  integer :: str, i, j, inds(r), indsp1(r+1), pos, cnt
306 
307  str = binomtable(r,r+nm1-1)
308  allocate(indspiprod(0:1,1:nm1,1:str))
309 
310  do i=1,str
311  inds = indcombiseq(1:r,i,r,nm1)
312 
313  pos = 1
314  do j=1,nm1
315 
316  cnt = 1
317  do while (pos.le.r)
318  if (inds(pos)>j) then
319  exit
320  else if (inds(pos).eq.j) then
321  cnt = cnt+1
322  end if
323  pos = pos+1
324  end do
325 
326  indsp1(1:pos-1) = inds(1:pos-1)
327  indsp1(pos) = j
328  indsp1(pos+1:r+1) = inds(pos:r)
329 
330  indspiprod(0,j,i) = calcposindcombiseq(nm1,r+1,indsp1)
331  indspiprod(1,j,i) = cnt
332 
333  end do
334 
335  end do
336 

◆ checktena_cll()

subroutine inittensors::checktena_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  T1,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  T2,
double complex, dimension(0:0), intent(in)  masses2,
double precision, dimension(0:rmax), intent(in)  norm,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out)  Tdiff 
)

Definition at line 635 of file InitTensors.F90.

635 
636  integer, intent(in) :: rmax
637  double complex, intent(in) :: T1(0:rmax,0:rmax,0:rmax,0:rmax)
638  double complex, intent(in) :: T2(0:rmax,0:rmax,0:rmax,0:rmax)
639  double complex, intent(in) :: masses2(0:0)
640  double precision, intent(in) :: norm(0:rmax)
641  double precision, intent(out) :: Tdiff(0:rmax)
642  integer :: r,n0,n1,n2,n3,i,j,flag
643  double complex :: diffTN
644  double precision :: ratio
645  character(len=*),parameter :: fmt1 = "(A8,'(',i2,') = dcmplx(',d25.18,',',d25.18,' )')"
646  character(len=*),parameter :: fmt2 = &
647  "(A6,' TNten(',i1,',',i1,',',i1,',',i1,') = (',d23.16,' , ',d23.16,' ), r=',i2)"
648  character(len=*),parameter :: fmt3 = &
649  "(A7,'(',i1,',',i2,') = dcmplx(',d25.18,' , ',d25.18,' )')"
650 
651  checkcntten_cll(1) = checkcntten_cll(1) + 1
652 
653 ! data CheckCntTN /0/
654 
655  flag=1
656  if(diffcntten_cll(1).ge.maxcheck_cll(1)) flag=0
657  if(ncheckout_cll.eq.-1) flag=0
658 
659  ratio=0d0
660 
661  tdiff=0d0
662  do r=0,rmax
663  do n0=0,r
664  do n1=0,r-n0
665  do n2=0,r-n0-n1
666  n3=r-n0-n1-n2
667 
668  difftn = t1(n0,n1,n2,n3)-t2(n0,n1,n2,n3)
669  tdiff(r) = max(tdiff(r),abs(difftn)/norm(r))
670  if ((abs(dreal(difftn)).gt.checkacc_cll*norm(r).or.abs(dimag(difftn)).gt.checkacc_cll*norm(r)) .and.(flag.eq.1)) then
671  write(ncheckout_cll,*) '***************************************************************************'
672  write(ncheckout_cll,'(A15,I2,A16,I10)') 'TNten with N =',1,' difference NO.', diffcntten_cll(1)+1
673  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
674  write(ncheckout_cll,'(A24,I2,A10,I2,A4,I2)') 'TNten integral with N =', 1, ' and rank ', r,' of ',rmax
675  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
676  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
677  write(ncheckout_cll,*) 'mode ', mode_cll
678  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
679  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
680  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
681  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
682  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
683  write(ncheckout_cll,*) 'nminf ', nminf_cll
684  do i=1,nminf_cll
685  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
686  end do
687  write(ncheckout_cll,*) 'dprec ', dprec_cll
688  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
689  write(ncheckout_cll,*) 'critacc ', critacc_cll
690  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
691  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
692  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
693  write(ncheckout_cll,fmt1) 'masses2', 0, masses2(0)
694  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
695  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,0,t1(0,0,0,0),0
696  write(ncheckout_cll,fmt2) 'DD :',0,0,0,0,t2(0,0,0,0),0
697  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(n0,n1,n2,n3),r
698  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(n0,n1,n2,n3),r
699  if(norm(r).ne.0d0)then
700  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
701  ratio=abs(difftn)/norm(r)
702  else
703  write(ncheckout_cll,*) 'diff:', 1d50
704  ratio=1d50
705  endif
706  flag=2
707  elseif((flag.eq.2).and.(abs(difftn).gt.ratio*norm(r))) then
708  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(n0,n1,n2,n3),r
709  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(n0,n1,n2,n3),r
710  if(norm(r).gt.1d-100)then
711  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
712  ratio=abs(difftn)/norm(r)
713  else
714  write(ncheckout_cll,*) 'diff:', 1d50
715  ratio=1d50
716  endif
717  elseif ((flag.eq.0).and.(abs(difftn).gt.checkacc_cll*norm(r))) then
718  flag=3
719  end if
720 
721  end do
722  end do
723  end do
724  end do
725 
726  if(flag.eq.2)then
727  write(ncheckout_cll,*) '*************************************************************************'
728  write(ncheckout_cll,*) ' end TNten '
729  write(ncheckout_cll,*)
730  diffcntten_cll(1) = diffcntten_cll(1) + 1
731  if(diffcntten_cll(1).eq.maxcheck_cll(1)) then
732  write(ncheckout_cll,*) ' Further output for differences in TNten functions suppressed for N =', 1
733  write(ncheckout_cll,*)
734  endif
735  else if (flag.eq.3) then
736  diffcntten_cll(1) = diffcntten_cll(1) + 1
737  endif
738 

◆ checktenalist_cll()

subroutine inittensors::checktenalist_cll ( double complex, dimension(rts(rmax)), intent(in)  T1,
double complex, dimension(rts(rmax)), intent(in)  T2,
double complex, dimension(0:0), intent(in)  masses2,
double precision, dimension(0:rmax), intent(in)  norm,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out)  Tdiff 
)

Definition at line 751 of file InitTensors.F90.

751 
752  integer, intent(in) :: rmax
753 ! double complex, intent(in) :: T1(0:RtS(rmax)), T2(0:RtS(rmax))
754  double complex, intent(in) :: T1(RtS(rmax)), T2(RtS(rmax))
755  double complex, intent(in) :: masses2(0:0)
756  double precision, intent(in) :: norm(0:rmax)
757  double precision, intent(out) :: Tdiff(0:rmax)
758  integer :: r,ind,i,j,flag,n0,n1,n2,n3
759  double complex :: diffTN
760  double precision :: ratio
761  character(len=*),parameter :: fmt1 = "(A8,'(',i2,') = dcmplx(',d25.18,',',d25.18,' )')"
762  character(len=*),parameter :: fmt2 = &
763  "(A6,' TNten(',i1,',',i1,',',i1,',',i1,') = (',d23.16,' , ',d23.16,' ), r=',i2)"
764  character(len=*),parameter :: fmt3 = &
765  "(A7,'(',i1,',',i2,') = dcmplx(',d25.18,' , ',d25.18,' )')"
766 
767  checkcntten_cll(1) = checkcntten_cll(1) + 1
768 
769 ! data CheckCntTN /0/
770 
771  flag=1
772  if(diffcntten_cll(1).ge.maxcheck_cll(1)) flag=0
773  if(ncheckout_cll.eq.-1) flag=0
774 
775  ratio=0d0
776 
777  tdiff=0d0
778  do r=0,rmax
779  do ind=rts(r-1)+1,rts(r)
780 
781  n0 = lorindtab(0,ind)
782  n1 = lorindtab(1,ind)
783  n2 = lorindtab(2,ind)
784  n3 = lorindtab(3,ind)
785  difftn = t1(ind)-t2(ind)
786  tdiff(r) = max(tdiff(r),abs(difftn)/norm(r))
787 
788  if ((abs(dreal(difftn)).gt.checkacc_cll*norm(r).or.abs(dimag(difftn)).gt.checkacc_cll*norm(r)) .and.(flag.eq.1)) then
789  write(ncheckout_cll,*) '***************************************************************************'
790  write(ncheckout_cll,'(A15,I2,A16,I10)') 'TNten with N =',1,' difference NO.', diffcntten_cll(1)+1
791  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
792  write(ncheckout_cll,'(A24,I2,A10,I2,A4,I2)') 'TNten integral with N =', 1, ' and rank ', r,' of ',rmax
793  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
794  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
795  write(ncheckout_cll,*) 'mode ', mode_cll
796  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
797  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
798  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
799  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
800  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
801  write(ncheckout_cll,*) 'nminf ', nminf_cll
802  do i=1,nminf_cll
803  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
804  end do
805  write(ncheckout_cll,*) 'dprec ', dprec_cll
806  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
807  write(ncheckout_cll,*) 'critacc ', critacc_cll
808  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
809  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
810  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
811  write(ncheckout_cll,fmt1) 'masses2', 0, masses2(0)
812  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
813  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,0,t1(1),0
814  write(ncheckout_cll,fmt2) 'DD :',0,0,0,0,t2(1),0
815  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(ind),r
816  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(ind),r
817  if(norm(r).ne.0d0)then
818  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
819  ratio=abs(difftn)/norm(r)
820  else
821  write(ncheckout_cll,*) 'diff:', 1d50
822  ratio=1d50
823  endif
824  flag=2
825  elseif((flag.eq.2).and.(abs(difftn).gt.ratio*norm(r))) then
826  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(ind),r
827  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(ind),r
828  if(norm(r).gt.1d-100)then
829  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
830  ratio=abs(difftn)/norm(r)
831  else
832  write(ncheckout_cll,*) 'diff:', 1d50
833  ratio=1d50
834  endif
835  elseif ((flag.eq.0).and.(abs(difftn).gt.checkacc_cll*norm(r))) then
836  flag=3
837  end if
838 
839  end do
840  end do
841 
842  if(flag.eq.2)then
843  write(ncheckout_cll,*) '*************************************************************************'
844  write(ncheckout_cll,*) ' end TNten '
845  write(ncheckout_cll,*)
846  diffcntten_cll(1) = diffcntten_cll(1) + 1
847  if(diffcntten_cll(1).eq.maxcheck_cll(1)) then
848  write(ncheckout_cll,*) ' Further output for differences in TNten functions suppressed for N =', 1
849  write(ncheckout_cll,*)
850  endif
851  else if (flag.eq.3) then
852  diffcntten_cll(1) = diffcntten_cll(1) + 1
853  endif
854 

◆ checktensors_cll()

subroutine inittensors::checktensors_cll ( double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  T1,
double complex, dimension(0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  T2,
double complex, dimension(0:3,n-1), intent(in)  MomVec,
double complex, dimension(binomtable(2,n)), intent(in)  MomInv,
double complex, dimension(0:n-1), intent(in)  masses2,
double precision, dimension(0:rmax), intent(in)  norm,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out)  Tdiff 
)

Definition at line 379 of file InitTensors.F90.

379 
380  integer, intent(in) :: N, rmax
381  double complex, intent(in) :: T1(0:rmax,0:rmax,0:rmax,0:rmax)
382  double complex, intent(in) :: T2(0:rmax,0:rmax,0:rmax,0:rmax)
383  double complex, intent(in) :: MomVec(0:3,N-1)
384  double complex, intent(in) :: MomInv(BinomTable(2,N)), masses2(0:N-1)
385  double precision, intent(in) :: norm(0:rmax)
386  double precision, intent(out) :: Tdiff(0:rmax)
387  integer :: r,n0,n1,n2,n3,i,j,flag
388  double complex :: diffTN
389  double precision :: ratio
390  character(len=*),parameter :: fmt1 = "(A8,'(',i2,') = dcmplx(',d25.18,' , ',d25.18,' )')"
391  character(len=*),parameter :: fmt2 = &
392  "(A6,' TNten(',i1,',',i1,',',i1,',',i1,') = (',d23.16,' , ',d23.16,' ), r=',i2)"
393  character(len=*),parameter :: fmt3 = &
394  "(A7,'(',i1,',',i2,') = dcmplx(',d25.18,' , ',d25.18,' )')"
395 
396 
397  checkcntten_cll(n) = checkcntten_cll(n) + 1
398 
399 ! data CheckCntTN /0/
400 
401  flag=1
402  if(diffcntten_cll(n).ge.maxcheck_cll(n)) flag=0
403  if(ncheckout_cll.eq.-1) flag=0
404 
405  ratio=0d0
406 
407  tdiff=0d0
408  do r=0,rmax
409  do n0=0,r
410  do n1=0,r-n0
411  do n2=0,r-n0-n1
412  n3=r-n0-n1-n2
413 
414  difftn = t1(n0,n1,n2,n3)-t2(n0,n1,n2,n3)
415  tdiff(r) = max(tdiff(r),abs(difftn)/norm(r))
416  if ((abs(difftn).gt.checkacc_cll*norm(r)) .and.(flag.eq.1)) then
417  write(ncheckout_cll,*) '***************************************************************************'
418  write(ncheckout_cll,'(A15,I2,A16,I10)') 'TNten with N =',n,', difference NO.', diffcntten_cll(n)+1
419  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
420  write(ncheckout_cll,'(A24,I2,A10,I2,A4,I2)') 'TNten integral with N =', n, ' and rank ', r,' of ',rmax
421  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
422  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
423  write(ncheckout_cll,*) 'mode ', mode_cll
424  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
425  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
426  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
427  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
428  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
429  write(ncheckout_cll,*) 'nminf ', nminf_cll
430  do i=1,nminf_cll
431  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
432  end do
433  write(ncheckout_cll,*) 'dprec ', dprec_cll
434  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
435  write(ncheckout_cll,*) 'critacc ', critacc_cll
436  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
437  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
438  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
439  do i=1,n-1
440  do j=0,3
441  write(ncheckout_cll,fmt3) 'MomVec', j, i, momvec(j,i)
442  end do
443  end do
444  do i=1,binomtable(2,n)
445  write(ncheckout_cll,fmt1) 'MomInv ', i, mominv(i)
446  end do
447  do i=0,n-1
448  write(ncheckout_cll,fmt1) 'masses2', i, masses2(i)
449  end do
450  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
451  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,0,t1(0,0,0,0),0
452  write(ncheckout_cll,fmt2) 'DD :',0,0,0,0,t2(0,0,0,0),0
453  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(n0,n1,n2,n3),r
454  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(n0,n1,n2,n3),r
455  if(norm(r).ne.0d0)then
456  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
457  ratio=abs(difftn)/norm(r)
458  else
459  write(ncheckout_cll,*) 'diff:', 1d50
460  ratio=1d50
461  endif
462  flag=2
463  elseif((flag.eq.2).and.(abs(difftn).gt.ratio*norm(r))) then
464  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(n0,n1,n2,n3),r
465  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(n0,n1,n2,n3),r
466  if(norm(r).gt.1d-100)then
467  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
468  ratio=abs(difftn)/norm(r)
469  else
470  write(ncheckout_cll,*) 'diff:', 1d50
471  ratio=1d50
472  endif
473  elseif ((flag.eq.0).and.(abs(difftn).gt.checkacc_cll*norm(r))) then
474  flag=3
475  end if
476 
477  end do
478  end do
479  end do
480  end do
481 
482  if(flag.eq.2)then
483  write(ncheckout_cll,*) '*************************************************************************'
484  write(ncheckout_cll,*) ' end TNten '
485  write(ncheckout_cll,*)
486  diffcntten_cll(n) = diffcntten_cll(n) + 1
487  if(diffcntten_cll(n).eq.maxcheck_cll(n)) then
488  write(ncheckout_cll,'((A),I4)') ' Further output for differences in TNten functions suppressed for N =', n
489  write(ncheckout_cll,*)
490  endif
491  else if (flag.eq.3) then
492  diffcntten_cll(n) = diffcntten_cll(n) + 1
493  endif
494 

◆ checktensorslist_cll()

subroutine inittensors::checktensorslist_cll ( double complex, dimension(rts(rmax)), intent(in)  T1,
double complex, dimension(rts(rmax)), intent(in)  T2,
double complex, dimension(0:3,n-1), intent(in)  MomVec,
double complex, dimension(binomtable(2,n)), intent(in)  MomInv,
double complex, dimension(0:n-1), intent(in)  masses2,
double precision, dimension(0:rmax), intent(in)  norm,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, dimension(0:rmax), intent(out)  Tdiff 
)

Definition at line 507 of file InitTensors.F90.

507 
508  integer, intent(in) :: N, rmax
509 ! double complex, intent(in) :: T1(0:RtS(rmax)), T2(0:RtS(rmax))
510  double complex, intent(in) :: T1(RtS(rmax)), T2(RtS(rmax))
511  double complex, intent(in) :: MomVec(0:3,N-1)
512  double complex, intent(in) :: MomInv(BinomTable(2,N)), masses2(0:N-1)
513  double precision, intent(in) :: norm(0:rmax)
514  double precision, intent(out) :: Tdiff(0:rmax)
515  integer :: r,ind,i,j,flag,n0,n1,n2,n3
516  double complex :: diffTN
517  double precision :: ratio
518  character(len=*),parameter :: fmt1 = "(A8,'(',i2,') = dcmplx(',d25.18,' , ',d25.18,' )')"
519  character(len=*),parameter :: fmt2 = &
520  "(A6,' TNten(',i1,',',i1,',',i1,',',i1,') = (',d23.16,' , ',d23.16,' ), r=',i2)"
521  character(len=*),parameter :: fmt3 = &
522  "(A7,'(',i1,',',i2,') = dcmplx(',d25.18,' , ',d25.18,' )')"
523 
524  checkcntten_cll(n) = checkcntten_cll(n) + 1
525 
526 ! data CheckCntTN /0/
527 
528  flag=1
529  if(diffcntten_cll(n).ge.maxcheck_cll(n)) flag=0
530  if(ncheckout_cll.eq.-1) flag=0
531 
532  ratio=0d0
533 
534  tdiff=0d0
535  do r=0,rmax
536  do ind=rts(r-1)+1,rts(r)
537 
538  n0 = lorindtab(0,ind)
539  n1 = lorindtab(1,ind)
540  n2 = lorindtab(2,ind)
541  n3 = lorindtab(3,ind)
542 
543  difftn = t1(ind)-t2(ind)
544  tdiff(r) = max(tdiff(r),abs(difftn)/norm(r))
545 
546  if ((abs(dreal(difftn)).gt.checkacc_cll*norm(r).or.abs(dimag(difftn)).gt.checkacc_cll*norm(r)) .and.(flag.eq.1)) then
547  write(ncheckout_cll,*) '***************************************************************************'
548  write(ncheckout_cll,'(A15,I2,A16,I10)') 'TNten with N =',n,' difference NO.', diffcntten_cll(n)+1
549  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
550  write(ncheckout_cll,'(A24,I2,A10,I2,A4,I2)') 'TNten integral with N =', n, ' and rank ', r,' of ',rmax
551  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
552  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
553  write(ncheckout_cll,*) 'mode ', mode_cll
554  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
555  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
556  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
557  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
558  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
559  write(ncheckout_cll,*) 'nminf ', nminf_cll
560  do i=1,nminf_cll
561  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
562  end do
563  write(ncheckout_cll,*) 'dprec ', dprec_cll
564  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
565  write(ncheckout_cll,*) 'critacc ', critacc_cll
566  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
567  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
568  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
569  do i=1,n-1
570  do j=0,3
571  write(ncheckout_cll,fmt3) 'MomVec', j, i, momvec(j,i)
572  end do
573  end do
574  do i=1,binomtable(2,n)
575  write(ncheckout_cll,fmt1) 'MomInv ', i, mominv(i)
576  end do
577  do i=0,n-1
578  write(ncheckout_cll,fmt1) 'masses2', i, masses2(i)
579  end do
580  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
581  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,0,t1(1),0
582  write(ncheckout_cll,fmt2) 'DD :',0,0,0,0,t2(1),0
583  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(ind),r
584  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(ind),r
585  if(norm(r).ne.0d0)then
586  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
587  ratio=abs(difftn)/norm(r)
588  else
589  write(ncheckout_cll,*) 'diff:', 1d50
590  ratio=1d50
591  endif
592  flag=2
593  elseif((flag.eq.2).and.(abs(difftn).gt.ratio*norm(r))) then
594  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,t1(ind),r
595  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,t2(ind),r
596  if(norm(r).gt.1d-100)then
597  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm(r)
598  ratio=abs(difftn)/norm(r)
599  else
600  write(ncheckout_cll,*) 'diff:', 1d50
601  ratio=1d50
602  endif
603  elseif ((flag.eq.0).and.(abs(difftn).gt.checkacc_cll*norm(r))) then
604  flag=3
605  end if
606 
607  end do
608  end do
609 
610  if(flag.eq.2)then
611  write(ncheckout_cll,*) '*************************************************************************'
612  write(ncheckout_cll,*) ' end TNten '
613  write(ncheckout_cll,*)
614  diffcntten_cll(n) = diffcntten_cll(n) + 1
615  if(diffcntten_cll(n).eq.maxcheck_cll(n)) then
616  write(ncheckout_cll,*) ' Further output for differences in TNten functions suppressed for N =', n
617  write(ncheckout_cll,*)
618  endif
619  else if (flag.eq.3) then
620  diffcntten_cll(n) = diffcntten_cll(n) + 1
621  endif
622 

◆ init_tables2()

subroutine inittensors::init_tables2 ( integer, intent(in)  Nm1,
integer, intent(in)  rmax 
)

Definition at line 52 of file InitTensors.F90.

52 
53  integer, intent(in) :: Nm1,rmax
54 
55  call setrts(rmax)
56  call setlorindtab(rmax)
57  call setaddindtab(rmax)
58  call setaddgtab(rmax)
59  call setcftab(rmax)
60  call setindspiprod(nm1,rmax)
61 

◆ setaddgtab()

subroutine inittensors::setaddgtab ( integer, intent(in)  rmax)

Definition at line 171 of file InitTensors.F90.

171 
172  integer, intent(in) :: rmax
173  integer :: r,nsum,mu,nu,munu,IndMu(0:3),IndN(0:3)
174 
175  if (rmax.le.1) return
176 
177  if (allocated(addgtab)) deallocate(addgtab)
178  allocate(addgtab(rts(rmax),rts(rmax/2)))
179 
180  do nsum=1,rmax/2
181  do nu=rts(nsum-1)+1,rts(nsum)
182  indn = lorindtab(:,nu)
183 
184  do munu=rts(2*nsum-1)+1,rts(2*nsum)
185  if (all(lorindtab(:,munu).eq.2*indn)) then
186  addgtab(1,nu) = munu
187  end if
188  end do
189 
190  do r=1,rmax-2*nsum
191  do mu=rts(r-1)+1,rts(r)
192  indmu = lorindtab(:,mu)
193 
194  do munu=rts(r+2*nsum-1)+1,rts(r+2*nsum)
195 
196  if (all(lorindtab(:,munu).eq.indmu+2*indn)) then
197  addgtab(mu,nu) = munu
198  end if
199 
200  end do
201 
202  end do
203  end do
204 
205  end do
206  end do
207 

◆ setaddindtab()

subroutine inittensors::setaddindtab ( integer, intent(in)  rmax)

Definition at line 136 of file InitTensors.F90.

136 
137  integer, intent(in) :: rmax
138  integer :: r,mu,nu,IndMu(0:3),i
139 
140  if (allocated(addindtab)) deallocate(addindtab)
141  allocate(addindtab(rts(rmax-1),0:3))
142 
143  addindtab(1,:) = (/ 2,3,4,5 /)
144  do r=1,rmax-1
145  do mu=rts(r-1)+1,rts(r)
146  indmu = lorindtab(:,mu)
147  do i=0,3
148  indmu(i) = indmu(i)+1
149  do nu=rts(r)+1,rts(r+1)
150  if (all(lorindtab(:,nu).eq.indmu)) then
151  addindtab(mu,i) = nu
152  end if
153  end do
154  indmu(i) = indmu(i)-1
155  end do
156  end do
157  end do
158 

◆ setcftab()

subroutine inittensors::setcftab ( integer, intent(in)  rmax)

Definition at line 220 of file InitTensors.F90.

220 
221  integer, intent(in) :: rmax
222  integer :: mu, nu, IndMu(0:3), IndNu(0:3), CF, i, r
223 
224  if (allocated(cftab)) deallocate(cftab)
225  allocate(cftab(rts(rmax),2:rts(rmax/2)))
226 
227  do r=0,rmax
228  do mu=rts(r-1)+1,rts(r)
229  indmu = lorindtab(:,mu)
230 
231  do nu=2,rts((rmax-r)/2)
232  indnu = lorindtab(:,nu)
233 
234  cf = (-1)**(indnu(1)+indnu(2)+indnu(3))
235  do i=0,3
236  cf = cf*calcfactorial(indmu(i)+2*indnu(i)) &
237  /(2**indnu(i)*calcfactorial(indmu(i))*calcfactorial(indnu(i)))
238  end do
239  cftab(mu,nu) = cf
240 
241  end do
242  end do
243  end do
244 

◆ setindspiprod()

subroutine inittensors::setindspiprod ( integer, intent(in)  Nm1max,
integer, intent(in)  rmax 
)

Definition at line 261 of file InitTensors.F90.

261 
262  integer, intent(in) :: Nm1max, rmax
263  integer :: strmax, Nm1
264 
265  strmax = binomtable(rmax,rmax+nm1max-1)
266  if (allocated(indspiprod)) then
267  deallocate(indspiprod)
268  end if
269  allocate(indspiprod(0:1,nm1max,strmax,nm1max))
270  indspiprod = 0
271 
272  do nm1=1,nm1max
273  strmax = binomtable(rmax,rmax+nm1-1)
274  indspiprod(0:1,1:nm1,1:strmax,nm1) = calcindspiprod(nm1,rmax)
275  end do
276 

◆ setlorindtab()

subroutine inittensors::setlorindtab ( integer, intent(in)  rmax)

Definition at line 98 of file InitTensors.F90.

98 
99  integer, intent(in) :: rmax
100  integer :: r,mu0,mu1,mu2,mu3,cnt
101 
102  if (allocated(lorindtab)) deallocate(lorindtab)
103  allocate(lorindtab(0:3,rts(rmax)))
104 
105  cnt = 1
106  do r=0,rmax
107  do mu0=r,0,-1
108  do mu1=r-mu0,0,-1
109  do mu2=r-mu0-mu1,0,-1
110  mu3=r-mu0-mu1-mu2
111 
112  lorindtab(0,cnt) = mu0
113  lorindtab(1,cnt) = mu1
114  lorindtab(2,cnt) = mu2
115  lorindtab(3,cnt) = mu3
116 
117  cnt = cnt+1
118 
119  end do
120  end do
121  end do
122  end do
123 

◆ setrts()

subroutine inittensors::setrts ( integer, intent(in)  rmax)

Definition at line 74 of file InitTensors.F90.

74 
75  integer, intent(in) :: rmax
76  integer :: r
77 
78  if (allocated(rts)) deallocate(rts)
79  allocate(rts(-1:rmax+1))
80 
81  rts(-1) = 0
82  do r=0,rmax+1
83  rts(r) = rts(r-1) + binomtable(r,r+3)
84  end do
85 

◆ switchoffcalcuv_ten()

subroutine inittensors::switchoffcalcuv_ten

Definition at line 349 of file InitTensors.F90.

349 
350  calcuv_ten = .false.
351 

◆ switchoncalcuv_ten()

subroutine inittensors::switchoncalcuv_ten

Definition at line 364 of file InitTensors.F90.

364 
365  calcuv_ten = .true.
366 

Variable Documentation

◆ addgtab

integer, dimension(:,:), allocatable inittensors::addgtab

Definition at line 37 of file InitTensors.F90.

◆ addindtab

integer, dimension(:,:), allocatable inittensors::addindtab

Definition at line 37 of file InitTensors.F90.

◆ calcuv_ten

logical inittensors::calcuv_ten

Definition at line 41 of file InitTensors.F90.

41  logical :: calcUV_ten

◆ cftab

integer, dimension(:,:), allocatable inittensors::cftab

Definition at line 37 of file InitTensors.F90.

37  integer, dimension(:,:), allocatable :: CFtab, LorIndTab, AddIndTab, AddGtab

◆ indspiprod

integer, dimension(:,:,:,:), allocatable inittensors::indspiprod

Definition at line 38 of file InitTensors.F90.

38  integer, dimension(:,:,:,:), allocatable :: IndsPiProd

◆ lorindtab

integer, dimension(:,:), allocatable inittensors::lorindtab

Definition at line 37 of file InitTensors.F90.

◆ rts

integer, dimension(:), allocatable inittensors::rts

Definition at line 39 of file InitTensors.F90.

39  integer, dimension(:), allocatable :: RtS

◆ stin

real inittensors::stin

Definition at line 40 of file InitTensors.F90.

40  real :: stin, stout, time1, time2, time3

◆ stout

real inittensors::stout

Definition at line 40 of file InitTensors.F90.

◆ time1

real inittensors::time1

Definition at line 40 of file InitTensors.F90.

◆ time2

real inittensors::time2

Definition at line 40 of file InitTensors.F90.

◆ time3

real inittensors::time3

Definition at line 40 of file InitTensors.F90.