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.
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.

Generated by   doxygen 1.8.17