coli_aux2.F90

Go to the documentation of this file.

!!
!!  File coli_aux2.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 coli_aux2   *
!  *   by Lars Hofer     *
!  *********************** 
! 
!  functions and subroutines:
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
#include "global_coli.h"
 
module coli_aux2
 
  use master
 
  implicit none
 
  integer :: nerrout_coli=6,ninfout_coli=6,ncpout_coli,nstatsout_coli
  integer :: errflag_coli,errcnt_coli,critpointscnt_coli,erroutlev_coli
  integer :: maxerrout_coli=100
  integer :: stdout_coli=6,mode_coli=0,closed_coli=-999    
  double precision :: dprec_coli, reqacc_coli, critacc_coli
 
  double precision :: acc_inf, acc_def_b, acc_def_c0, acc_def_d0
  double precision :: acc_req_c, acc_req_d, acc_req_cind
  double precision :: impest_d=1d1, impest_c=1d1
  integer :: rmax_b, rmax_c, rmax_d
  logical :: inflev_coli
 
contains
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !    subroutine initcoli_in_collier
  !    fixing of default values for various variables                       *
  ! 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initcoli_in_collier
 
    implicit   none
!    logical    init
!
!    data init /.false./
!    save init
!    
!    if (init) return
!    init = .true.
    
  ! scale factor for *small* masses masses
    call setminfscale2_coli(1d0)
#ifdef SING
  ! shift of mass-singular squared logarithms
    call setshiftms2_coli(0d0)
#endif
 
  
  ! estimate of CPU precision 
  !    calacc = dprec_coli
  ! infinitesimal parameter
  !    eps    = dprec_coli/4d0
  ! size of imaginary parts below which explicit ieps take over
  !    impacc = dprec_coli/4d4
  !  done via GetCPUprec_cll
  !  call setprecpars_coli(dprec_coli)
 
  ! infinitesimal accuracy 
    acc_inf = 1d40
 
!    acc_min_C = 1d0
!    acc_min_D = 1d0
 
 
  end subroutine initcoli_in_collier
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitErrCnt_coli(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initerrcnt_coli(val)
 
    integer, intent(in) :: val
 
    errcnt_coli = val
 
  end subroutine initerrcnt_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitCritPointsCnt_coli(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initcritpointscnt_coli(val)
 
    integer, intent(in) :: val
 
    critpointscnt_coli = val
 
  end subroutine initcritpointscnt_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetErrFlag_coli(err)
  !
  !  -1 Check failed
  !  -4 Argument on cut       (only if CHECK set)
  !  -5 Critical event
  !  -6 No reduction method works
  !  -6 momenta not 4-dimensional
  !  -7 specific numerical problem
  !  
  ! -10 Case not supported/implemented
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine seterrflag_coli(err)
 
    integer, intent(in) :: err
 
    errflag_coli = err
 
  end subroutine seterrflag_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine getErrFlag_coli(err)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine geterrflag_coli(err)
 
    integer, intent(out) :: err
 
    err = errflag_coli
 
  end subroutine geterrflag_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine setnerrout_coli(nerrout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setnerrout_coli(nerrout)
 
    integer, intent(in) :: nerrout
 
    nerrout_coli = nerrout
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: nerrout_coli set to = ',nerrout_coli
    endif
 
  end subroutine setnerrout_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine setncpout_coli(ncpout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setncpout_coli(ncpout)
 
    integer, intent(in) :: ncpout
 
    ncpout_coli = ncpout
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: ncpout_coli set to = ',ncpout_coli
    endif
 
  end subroutine setncpout_coli 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine setninfout_coli(ninfout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setninfout_coli(ninfout)
 
    integer, intent(in) :: ninfout
 
    ninfout_coli = ninfout
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: ninfout_coli set to = ',ninfout_coli
    endif
 
  end subroutine setninfout_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine setnstatsout_coli(nstatsout) 
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setnstatsout_coli(nstatsout)
 
    integer, intent(in) :: nstatsout
 
    nstatsout_coli = nstatsout
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: nstatsout_coli set to = ',nstatsout_coli
    endif
 
  end subroutine setnstatsout_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxErrOut_coli(errmax) 
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxerrout_coli(errmax)
 
    integer, intent(in) :: errmax
 
    maxerrout_coli = errmax
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: maxErrOut_coli set to = ',maxerrout_coli
    endif
 
  end subroutine setmaxerrout_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetErroutlev_coli(erroutlev)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine seterroutlev_coli(erroutlev)
 
    integer, intent(in) :: erroutlev
 
    erroutlev_coli = erroutlev
    
 
  end subroutine seterroutlev_coli
  
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine ErrOut_coli(sub,err,flag)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
! Suppression of output must be implemented in calling routines!
 
  subroutine errout_coli(sub,err,flag)
 
    character(len=*), intent(in) :: sub, err
!    integer, parameter :: maxErrOut=100
    logical, intent(out) :: flag
  
    flag = .false.
    if(erroutlev_coli.eq.0) return
 
    errcnt_coli = errcnt_coli + 1  
    if (errcnt_coli.le.maxerrout_coli) then
      write(nerrout_coli,*)
      write(nerrout_coli,*)
      write(nerrout_coli,*)
      write(nerrout_coli,*) '***********************************************************'
      write(nerrout_coli,*) 'ERROR NO.', errcnt_coli
      write(nerrout_coli,*) 'in routine: ', trim(sub)
      write(nerrout_coli,*) trim(err)
      call writemaster_cll(nerrout_coli)
      flag = .true.
    elseif (errcnt_coli.eq.maxerrout_coli+1) then
      write(nerrout_coli,*)
      write(nerrout_coli,*)
      write(nerrout_coli,*)
      write(nerrout_coli,*) '***********************************************************'
      write(nerrout_coli,*)
      write(nerrout_coli,*) ' Further output of Errors will be suppressed '
      write(nerrout_coli,*)
    endif
 
  end subroutine errout_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine CritPointsOut_coli(sub,acc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine critpointsout_coli(sub,acc)
 
    character(len=*), intent(in) :: sub
    double precision, intent(in) :: acc
    integer :: i
 
#include "common_coli.h"
 
    critpointscnt_coli = critpointscnt_coli + 1    
 
    write(ncpout_coli,*)
    write(ncpout_coli,*)
    write(ncpout_coli,*)
    write(ncpout_coli,*) '***********************************************************'
    write(ncpout_coli,*) 'Critical Point NO.', critpointscnt_coli
    write(ncpout_coli,*) 'in integral: ', trim(sub)
    write(ncpout_coli,*) 'estimated accuracy: ', acc
    write(ncpout_coli,*) '-----------------------------------------------------------'
    write(ncpout_coli,*) 'GLOBAL PARAMETERS:'
    write(ncpout_coli,*) 'muUV2 =     ', muuv2
    write(ncpout_coli,*) 'muIR2 =     ', muir2
#ifdef SING
    write(ncpout_coli,*) 'deltaUV =   ', deltauv
    write(ncpout_coli,*) 'deltaIR1 =  ', delta1ir
    write(ncpout_coli,*) 'deltaIR2 =  ', delta2ir
#endif
    write(ncpout_coli,*) 'nminf =     ', ncoliminf
    do i=1,ncoliminf
      write(ncpout_coli,*) 'minf2 =     ', i, coliminf2(i)
    end do
    write(ncpout_coli,*) 'dprec =     ', dprec_coli
    write(ncpout_coli,*) 'reqacc =    ', reqacc_coli
    write(ncpout_coli,*) 'critacc =   ', critacc_coli
    write(ncpout_coli,*) 'ErrFlag =   ', errflag_coli
!   write(ncpout_coli,*) '------------------------------------------------------------'
    call writemaster_cll(ncpout_coli)
 
  end subroutine critpointsout_coli
 
 
 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMode_coli(mode)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setmode_coli(mode)
 
    integer, intent(in) :: mode
 
    mode_coli = mode
    if(mode.lt.1) then 
      impest_c = 1d1
      impest_d = 1d1
    else
      impest_c = 1d0
      impest_d = 1d0
    end if
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: Mode_coli set to = ',mode_coli
    endif
 
  end subroutine setmode_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine setprec_coli(dprec)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setprec_coli(dprec)
 
    double precision, intent(in) :: dprec
 
    dprec_coli = dprec
 
! adapted to precision of D0 and C0
    acc_def_b = dprec_coli
    acc_def_c0 = 1d1*dprec_coli
    acc_def_d0 = 1d1*dprec_coli
 
    call setprecpars_coli(dprec)
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: dprec_coli set to = ',dprec_coli
    endif
 
  end subroutine setprec_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetAcc_coli(reqacc,critacc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setacc_coli(reqacc,critacc)
 
    double precision, intent(in) :: reqacc,critacc
 
    reqacc_coli = reqacc
    acc_req_c = reqacc
    acc_req_cind = reqacc/1d1
    acc_req_d = reqacc
 
    critacc_coli = critacc
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: reqacc_coli set to  = ',reqacc_coli
      write(ninfout_coli,*)  'COLI: critacc_coli set to = ',critacc_coli
    endif
 
  end subroutine setacc_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetReqAcc_coli(reqacc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setreqacc_coli(reqacc)
 
    double precision, intent(in) :: reqacc
 
    reqacc_coli = reqacc
    acc_req_c = reqacc
    acc_req_cind = reqacc/1d1
    acc_req_d = reqacc
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: reqacc_coli set to  = ',reqacc_coli
    endif
 
  end subroutine setreqacc_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetCritAcc_coli(critacc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setcritacc_coli(critacc)
 
    double precision, intent(in) :: critacc
 
    critacc_coli = critacc
 
    if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
      write(ninfout_coli,*)  'COLI: critacc_coli set to = ',critacc_coli
    endif
 
  end subroutine setcritacc_coli
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetRitmax_coli(ritmax_B,ritmax_C,ritmax_D)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setritmax_coli(ritmax_B,ritmax_C,ritmax_D)
 
    integer, intent(in) :: ritmax_B,ritmax_C, ritmax_D
 
    if (ritmax_d.lt.6) then
      if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
        write(ninfout_coli,*) 'COLI: SetRitmax_coli'
        write(ninfout_coli,*) 'rmax_D has to be at least 6 --> it is set to 6'
      end if
      rmax_d = 6
    else
      rmax_d = ritmax_d
      if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
        write(ninfout_coli,*)  'COLI: rmax_D set to = ',rmax_d
      endif
    end if
 
    if (ritmax_c.le.rmax_d) then
      if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
        write(ninfout_coli,*) 'COLI: SetRitmax_coli'
        write(ninfout_coli,*) 'rmax_C has to be larger than rmax_D --> it is set to rmax_D+1'
      end if
      rmax_c = rmax_d+1
    else
      rmax_c = ritmax_c
      if(inflev_coli.and.ninfout_coli.ne.closed_cll)then
        write(ninfout_coli,*)  'COLI: rmax_C set to = ',rmax_c
      endif
    end if
 
    if (ritmax_b.le.rmax_c) then
      if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
        write(ninfout_coli,*) 'COLI: SetRitmax_coli'
        write(ninfout_coli,*) 'rmax_B has to be larger than rmax_C --> it is set to rmax_C+1'
      end if
      rmax_b = rmax_c+1
    else
      rmax_b = ritmax_b
      if(inflev_coli.and.ninfout_coli.ne.closed_coli)then
        write(ninfout_coli,*)  'COLI: rmax_B set to = ',rmax_b
      endif
    end if
 
 
  end subroutine setritmax_coli
 
 
end module coli_aux2