DD_global.F90

Go to the documentation of this file.

!!
!!  File DD_global.F90 is part of COLLIER
!!  - A Complex One-Loop Library In Extended Regularizations
!!
!!  Copyright (C) 2015, 2016   Ansgar Denner, Stefan Dittmaier, Lars Hofer
!!
!!  COLLIER is licenced under the GNU GPL version 3, see COPYING for details.
!!
!!----------------------------------------------------------------------
 
module dd_global
  integer                       :: rmax2,rmax3,rmax4,rmax5,rmax6,nmax,rmax
  integer                       :: r2max2,r2max3,r2max4,r2max5,r2max6
  integer (kind=8)              :: ncoefmax2,ncoefmax3,ncoefmax4,ncoefmax5,ncoefmax6
  integer (kind=8)              :: ncoefmax3_int,ncoefmax4_int
  integer,allocatable,dimension(:)   :: tid,ntid
  integer (kind=8),allocatable,dimension(:,:) :: binc
 
  double precision              :: cacc,dacc
  integer                       :: mode34,mode5,mode6,ritmax
  integer                       :: outlevel,outchannel,cout,coutmax
  logical                       :: cout_on
 
  double precision, allocatable, dimension(:)         :: aimacc,erracc
  double precision, allocatable, dimension(:,:)       :: resaccabs,resaccrel,resaccabs2,resaccrel2
  integer                       :: nmaster,r2master,accflag,errflag,stopflag
 
  double precision              :: deltauv,muv2,delta2ir,delta1ir,mir2,mx2(100)
 
  double complex, allocatable, dimension(:)           :: scalint,scalintnew
  double precision, allocatable, dimension(:)         :: scalint_err
  double complex, allocatable, dimension(:,:)         :: auxc
  double precision, allocatable, dimension(:,:)       :: auxr
  double precision, allocatable, dimension(:)         :: acc_pave,acc_new
  double precision, allocatable, dimension(:,:)       :: accr2_aux,accr2_newprelim,accr2_new_aux
  double precision, allocatable, dimension(:)         :: maxtxij,maxttx0klm
  double precision, allocatable, dimension(:)         :: maxttx0ijm,maxtz_nj,maxttz_knlm,ttzff_kl
  integer, allocatable,dimension(:,:) :: auxi
  integer, allocatable,dimension(:)   :: r2_aux,r2_new_aux,r2_newprelim,qmethod,qmethod_new
  integer                             :: nc_ddin,nr_ddin,ni_ddin,i_ddin(100)
  double complex                      :: c_ddin(100)
  double precision                    :: r_ddin(100)
  character(len=20)                   :: s_ddin
 
  double precision                    :: dprec_dd
 
end module dd_global
 
 
module dd_2pt
  double complex, allocatable, dimension(:,:,:)         :: b_cache,buv_cache
end module dd_2pt
 
module dd_3pt
  double complex, allocatable, dimension(:,:)         :: c_cache,cuv_cache,c_new_cache,cuv_new_cache
  double complex, allocatable, dimension(:,:,:,:,:)   :: ttx2_aux
  double complex, allocatable, dimension(:,:,:)       :: x2_aux,tx2_aux
  double precision, allocatable, dimension(:,:)       :: cij_err,c00_err,cij_err2,cij_err_newprelim
  double precision, allocatable, dimension(:,:)       :: c00_err_newprelim,cij_err_new,c00_err_new
  double precision, allocatable, dimension(:,:,:)     :: z2_aux,tz2_aux,z2i_aux
  double precision, allocatable, dimension(:,:,:,:,:) :: ttz2_aux
end module dd_3pt
 
module dd_4pt
  double complex, allocatable, dimension(:,:)         :: d_cache,duv_cache
  double precision, allocatable, dimension(:,:)       :: dij_err,d00_err,dij_err_new,d00_err_new,dij_err2
end module dd_4pt
 
module dd_5pt
  double precision, allocatable, dimension(:,:)       :: eij_err,eij_err2
end module dd_5pt
 
module dd_6pt
  double precision, allocatable, dimension(:,:)       :: fij_err,fij_err2
end module dd_6pt
 
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Initialization of global DD parameters
!--------------------------------------------------------------
! 18.2.2016 Stefan Dittmaier
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
subroutine init_dd_global(nmax_in,ritmax_in)
 
  use dd_global
  use dd_2pt
  use dd_3pt
  use dd_4pt
  use dd_5pt
  use dd_6pt
 
  integer, intent(in) :: nmax_in,ritmax_in
  integer             :: id,n,k
  integer (kind=8)    :: Binomial_DD
 
  ritmax = ritmax_in
 
! dimensions for array declarations
  rmax6  = 6
  rmax5  = 5
  rmax4  = ritmax+3
  rmax3  = rmax4+2
  rmax2  = rmax4+4
  rmax   = 2*rmax2
 
! maximal rank of N-point tensors
!  -> dimensions for arrays in internal cache 
  r2max6  = rmax6
  r2max5  = r2max6-1
!  r2max4  = r2max5-1
!changed SD 28.6.17
  r2max4  = rmax4
  r2max3  = rmax3
  r2max2  = rmax2
 
! store some  binomial coefficients
  if (allocated(binc)) then
    deallocate(binc)
  endif
  allocate(binc(0:r2max3,0:r2max3))
  do n=0,r2max3
    do k=0,r2max3
      binc(n,k) = binomial_dd(n,k)
    enddo
  enddo
 
  ncoefmax4_int = binomial_dd(r2max4+4,4)
  ncoefmax3_int = binomial_dd(r2max3+3,3)
 
  ncoefmax2 = 2*binomial_dd(r2max2+2,2) + 2*r2max2 + 13
  ncoefmax3 = 2*binomial_dd(r2max3+3,3) + 8*r2max3 + 11
  ncoefmax4 = 2*binomial_dd(r2max4+4,4) + 7*r2max4 + 10    ! conservative upper limit
  ncoefmax5 = 2*binomial_dd(r2max5+5,5) + 6*r2max5 + 9
  ncoefmax6 = 2*binomial_dd(r2max6+6,6) + 6*r2max6 + 9
 
  nmax = nmax_in
 
! identifiers for N-point functions
  if (allocated(tid)) then
    deallocate(tid,ntid)
  end if
  allocate(tid(0:2**nmax_in-1),ntid(0:nmax_in))
  ntid(0:nmax) = 0
  do id=0,2**nmax-1
    n=0
    do k=0,nmax-1
      if (mod(id,2**(k+1))/2**k.eq.0) n=n+1
    enddo
    ntid(n) = ntid(n)+1
    tid(id) = ntid(n)
  enddo
 
  if (allocated(aimacc)) then
    deallocate(aimacc,erracc)
  end if
  allocate(aimacc(nmax),erracc(nmax))
  
  if (allocated(resaccabs)) then
    deallocate(resaccabs,resaccrel,resaccabs2,resaccrel2)
  end if
  allocate(resaccabs(0:2**nmax,0:rmax),resaccrel(0:2**nmax,0:rmax))
  allocate(resaccabs2(0:2**nmax,0:rmax),resaccrel2(0:2**nmax,0:rmax))
 
! arrays depending on nmax and any r2max#
 
  if (allocated(b_cache)) then
    deallocate(b_cache,buv_cache)
  end if
  if (nmax.ge.2) then
    allocate(b_cache(ntid(2),0:r2max2,0:r2max2))
    allocate(buv_cache(ntid(2),0:r2max2,0:r2max2))
  endif
 
  if (allocated(c_cache)) then
    deallocate(c_cache,cuv_cache,c_new_cache,cuv_new_cache)
    deallocate(cij_err,c00_err,cij_err2)
    deallocate(cij_err_newprelim,c00_err_newprelim,cij_err_new,c00_err_new)
    deallocate(accr2_aux,accr2_newprelim,accr2_new_aux)
  endif
  if (nmax.ge.3) then
    allocate(c_cache(ntid(3),ncoefmax3_int))
    allocate(cuv_cache(ntid(3),ncoefmax3_int))
    allocate(c_new_cache(ntid(3),ncoefmax3_int))
    allocate(cuv_new_cache(ntid(3),ncoefmax3_int))
    allocate(cij_err(ntid(3),0:2*r2max3))
    allocate(c00_err(ntid(3),0:2*r2max3))
    allocate(cij_err2(ntid(3),0:2*r2max3))
    allocate(cij_err_newprelim(ntid(3),0:2*r2max3))
    allocate(c00_err_newprelim(ntid(3),0:2*r2max3))
    allocate(cij_err_new(ntid(3),0:2*r2max3))
    allocate(c00_err_new(ntid(3),0:2*r2max3))
    allocate(accr2_aux(ntid(3),0:2*r2max3))
    allocate(accr2_newprelim(ntid(3),0:2*r2max3))
    allocate(accr2_new_aux(ntid(3),0:2*r2max3))
  endif
 
  if (allocated(d_cache)) then
    deallocate(d_cache,duv_cache)
    deallocate(dij_err,d00_err,dij_err_new,d00_err_new,dij_err2)
  endif
  if (nmax.ge.4) then
    allocate(d_cache(ntid(4),ncoefmax4_int))
    allocate(duv_cache(ntid(4),ncoefmax4_int))
    allocate(dij_err(ntid(4),0:2*r2max4))
    allocate(d00_err(ntid(4),0:2*r2max4))
    allocate(dij_err_new(ntid(4),0:2*r2max4))
    allocate(d00_err_new(ntid(4),0:2*r2max4))
    allocate(dij_err2(ntid(4),0:2*r2max4))
  endif
 
  if (allocated(eij_err)) then
    deallocate(eij_err,eij_err2)
  endif
  if (nmax.ge.5) then
    allocate(eij_err(ntid(5),0:2*r2max5))
    allocate(eij_err2(ntid(5),0:2*r2max5))
  endif
 
  if (allocated(fij_err)) then
    deallocate(fij_err,fij_err2)
  endif
  if (nmax.ge.6) then
    allocate(fij_err(ntid(6),0:2*r2max6))
    allocate(fij_err2(ntid(6),0:2*r2max6))
  endif
 
! arrays depending only on nmax
 
  if (allocated(z2i_aux)) then
    deallocate(z2_aux,tz2_aux,z2i_aux,ttz2_aux)
    deallocate(x2_aux,tx2_aux,ttx2_aux)
  endif
  if (nmax.ge.3) then
    allocate(z2i_aux(ntid(3),2,2),ttz2_aux(ntid(3),2,2,2,2))
    allocate(z2_aux(ntid(3),2,2),tz2_aux(ntid(3),2,2))
    allocate(x2_aux(ntid(3),0:2,0:2),tx2_aux(ntid(3),0:2,0:2))
    allocate(ttx2_aux(ntid(3),0:2,0:2,0:2,0:2))
  endif
 
  if (allocated(scalint)) then
    deallocate(scalint,scalint_err,scalintnew)
    deallocate(auxc)
    deallocate(auxr)
    deallocate(acc_pave,acc_new)
    deallocate(maxtxij,maxttx0klm,maxttx0ijm)
    deallocate(maxtz_nj,maxttz_knlm,ttzff_kl)
    deallocate(auxi,r2_aux,r2_new_aux,r2_newprelim,qmethod,qmethod_new)
  end if
 
  allocate(scalint(0:2**nmax),scalint_err(0:2**nmax),scalintnew(0:2**nmax))
  allocate(maxtxij(0:2**nmax),maxttx0klm(0:2**nmax),maxttx0ijm(0:2**nmax))
  allocate(maxtz_nj(0:2**nmax),maxttz_knlm(0:2**nmax),ttzff_kl(0:2**nmax))
  allocate(acc_pave(0:2**nmax),acc_new(0:2**nmax))
  allocate(auxr(0:2**nmax,2))
  allocate(auxc(0:2**nmax,7))
  allocate(auxi(0:2**nmax,6))
  allocate(r2_aux(0:2**nmax),r2_new_aux(0:2**nmax),r2_newprelim(0:2**nmax))
  allocate(qmethod(0:2**nmax),qmethod_new(0:2**nmax))
 
end subroutine init_dd_global
 
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Binomial coefficient
!--------------------------------------------------------------
! 18.2.2016 Stefan Dittmaier
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
integer (kind=8) function binomial_dd(n,m)
  integer :: i,n,m
 
  binomial_dd = 1
  if ((m.ge.0).and.(m.le.n)) then
    do i=1,m
      binomial_dd = binomial_dd*(n+1-i)
      binomial_dd = binomial_dd/i
    enddo
  else
    binomial_dd = 0
  endif
 
end function binomial_dd
 
module dd_statistics
 
  integer :: dpv_calc_dd,dpv_ok_dd
  integer :: dapv_calc_dd,dapv_ok_dd,dg_calc_dd,dg_ok_dd
  integer :: dg2_calc_dd,dg2_ok_dd,dgc_calc_dd,dgc_ok_dd
  integer :: d_bad_dd
 
end module dd_statistics