collier_init.F90

Go to the documentation of this file.

!!
!!  File collier_init.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.
!!
 
!#define CritPointsCOLI 
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!  *************************
!  *  module collier_init  *
!  *     by Lars Hofer     *
!  ************************* 
! 
!  functions and subroutines:
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 
 
 
module collier_init
 
 
  use collier_global
  use collier_aux
  use combinatorics
  use cache
  use coli_aux2
  use coli_stat
  use inittensors
 
  implicit none
  interface setmaxcheck_cll
    module procedure setmaxcheckn_cll,setmaxcheckarray_cll
  end interface setmaxcheck_cll
  interface setmaxcritpoints_cll
    module procedure setmaxcritpointsn_cll,setmaxcritpointsarray_cll
  end interface setmaxcritpoints_cll
  
  
  character(len=80) :: foldername_cll
!  logical :: qopened_critcoli,qopened_crit,qopened_crit2,qopened_statscoli
 
contains
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Init_cll(Nmax,rmax,folder_name,noreset)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine init_cll(Nmax,rmax,folder_name,noreset)
 
    integer, intent(in) :: Nmax
    integer, optional, intent(in) :: rmax
    character(len=*), optional, intent(in) :: folder_name
    logical, optional, intent(in) :: noreset
    integer :: mode,erroutlev,infoutlev,nminf,ritmax
    integer :: ritmaxB,ritmaxC,ritmaxD
    double precision :: muUV2, muIR2
    double precision :: deltaUV, deltaIR1, deltaIR2
    double complex, allocatable :: minf2(:)
    double precision :: acc0, acc1, acc2
    integer :: i,tenred,nchan,rmax0
    logical :: reset
    character(len=*),parameter :: fmt90 = "(A40,I10)"
    character(len=*),parameter :: fmt91 = "(A40,Es17.10)"
    character(len=*),parameter :: fmt95 = "(A47,I10)"
    character(len=*),parameter :: fmt98 = &
        "(7x,'minf2_cll(',i2,') = ',Es17.10)"
    character(len=*),parameter :: fmt96 = &
        "(7x,'cache no.',i2,': only internal calls cached')"
    character(len=*),parameter :: fmt97 = &
        "(7x,'cache no.',i2,': external and internal calls cached')"
 
    if (present(noreset)) then 
      if(noreset) then
        reset = .false.
        if (.not.initialized_cll) then
          reset = .true.
        else
          if (present(folder_name)) then
            if (nofiles_cll) then
              if (len(trim(folder_name)).ne.0) then
                reset = .true.
                call reset_cll
              end if
            else
              if (len(trim(folder_name)).eq.0) then
                reset = .true.
                call reset_cll
              end if
            end if
          end if
        end if
      else
        if (initialized_cll) call reset_cll
        reset = .true.
      end if
    else
      if (initialized_cll) call reset_cll
      reset = .true.
    end if
 
    if (reset) then
      if (present(folder_name)) then
        if (len(trim(folder_name)).eq.0) then
          erroutlev = 0
          infoutlev = 0
          nofiles_cll = .true.
        else
          erroutlev = 1
          infoutlev = 2
          foldername_cll = trim(folder_name)
          nofiles_cll = .false.
        end if
      else
        erroutlev = 1
        infoutlev = 2
        foldername_cll = "output_cll"
        nofiles_cll = .false.
      end if
    else
      call geterroutlev_cll(erroutlev)
      call getinfoutlev_cll(infoutlev)
    end if
    
    nmax_cll = nmax
    if(present(rmax)) then
      rmax0 = rmax
    else
      rmax0 = nmax
    end if
    rmax_cll = rmax0
    
    call setinfoutlev_cll(0)
    call seterroutlev_cll(0)
 
    call initcheckcnt_cll(.not.reset)
    call initmaxcheck_cll(.not.reset)
    if(.not.reset) then
      if (monitoring) then
        call initpointscnt_cll(.not.reset)
        call initmaxcritpoints_cll(.not.reset)        
      end if
    else
      monitoring=.false.   
    end if
    
    if (reset) then
      call initoutchan_cp_cll
      call initoutchan_cll      
      
      call initcheckcntdb_cll
      call initmaxcheckdb_cll
      
      call setmaxerrout_cll(100)
      call setmaxerroutcoli_cll(100)
      call setmaxerroutdd_cll(100)
      call setmaxinfout_cll(1000)
 
      if (erroutlev.ge.1) then
! set output-file for potential errors
        call execute_command_line('mkdir -p '//trim(foldername_cll))
        
        call initerrcnt_cll(0)
        call openerroutfile_cll(trim(foldername_cll)//'/ErrOut.cll')
        
        call initerrcntcoli_cll()
!      call OpenErrOutFileCOLI_cll(trim(foldername_cll)//'/ErrOut.coli')
!
        call initerrcntdd_cll()
!      call OpenErrOutFileDD_cll(trim(foldername_cll)//'/ErrOut.dd')
      end if
 
      if (infoutlev.ge.1) then
        call openinfoutfile_cll(trim(foldername_cll)//'/InfOut.cll')
        
! no output from COLI  (comes via COLLIER)
        call setinfoutlevcoli_cll(0)
        
        call initinfcnt_cll(0)
 
      end if
    end if
 
      
    ! default values.
    mode = 1
 
    muuv2 = 1d0
    muir2 = 1d0
 
    deltauv = 0d0
    deltair1 = 0d0
    deltair2 = 0d0
    
    ritmax = max(14,rmax0+4-nmax)
    ritmaxd = ritmax
    ritmaxc = ritmax+2
    ritmaxb = ritmax+4
 
    ! initialise COLI
    call initcoli_in_collier()
    ! set global parameters for DD
    call initglobaldd_cll(nmax,ritmax)
    call ddsetcout_on(.false.)
 
    nminf = 0
    if (allocated(minf2)) then
      deallocate(minf2)
    end if
    allocate(minf2(nminf))
 
! required accuracy
    acc0 = 1d-8
! critical accuracy
    acc1 = 1d-1  !CritPoints
! check accuracy  
    acc2 = 1d-2   
 
 
    ! COLLIER mode
    call setmode_cll(mode)
 
    ! set UV and IR parameters
    call setmuuv2_cll(muuv2)
    call setmuir2_cll(muir2)
    call setdeltauv_cll(deltauv)
    call setdeltair_cll(deltair1,deltair2)
 
    ! specify infinitesimal mass regulators
    call setminf2_cll(nminf,minf2)
 
    ! CPU precision and accuracy
    call getcpuprec_cll()
    ! call SetAccuracy_cll(acc0,acc1,acc2)
    call setreqacc_cll(acc0)
    call setcritacc_cll(acc1)
    call setcheckacc_cll(acc2)
 
    ! set maximum number of rank
    call setritmax_cll(ritmax)
 
    ! initialize Cache-system
    call initcachesystem_cll(0,nmax)
 
    ! initialize table of binomial coefficients
    call setbinomtable(rmax0+max(nmax-2,4))
 
    ! initialization for tensors
    call setindcombiseq(nmax-1,rmax0)
    call setaddtocind(nmax-1,rmax0)
    call setdropcind(nmax-1,rmax0)
    call setdropcind2(nmax-1,rmax0)
    call init_tables2(nmax-1,rmax0)
    
!    ! initialize table of binomial coefficients
!    call SetBinomTable(2*Nmax)
!
!    ! initialization for tensors
!    call SetIndCombisEq(Nmax,Nmax)
!    call SetAddToCInd(Nmax,Nmax)
!    call SetDropCInd(Nmax,Nmax)
!    call SetDropCInd2(Nmax,Nmax)
!    call init_tables2(Nmax,Nmax)    
 
    ! choose if UV poles are calculated completely
    ! call SwitchOffCalcUV_cll()
    call switchoncalcuv_cll()
 
    ! choose to include IR rational terms
    call switchonirrational_cll()
 
    ! choose direct tensor reduction for N>=6
    call switchontenred_cll()
 
    ! initialize counter PS points
    call initeventcnt_cll()
 
    ! stop if fatal error occurs
    call seterrstop_cll(-8)
 
 
!    call AddMinf2_cll(dcmplx(0.001d0))
 
    ! COLLIER has been initialized
    initialized_cll = .true.
    call setinfoutlev_cll(infoutlev)
    call seterroutlev_cll(erroutlev)
 
    if (reset) then
 
    ! set standard output for infos 
    call writeintro_cll(stdout_cll)
    if (infoutlev.ge.1) then
      write(unit=stdout_cll,fmt=*) '                                                          '
      write(unit=stdout_cll,fmt=*) '***********************************************************'
      write(unit=stdout_cll,fmt=*) '                                                           '
      write(unit=stdout_cll,fmt=*) '  COLLIER: information on settings and internal parameters '
      write(unit=stdout_cll,fmt=*) '    is written to the file ',trim(foldername_cll)//'/InfOut.cll'
      write(unit=stdout_cll,fmt=*) '                                                           '
      write(unit=stdout_cll,fmt=*) '***********************************************************'
      write(unit=stdout_cll,fmt=*) '                                                           '
 
      ! add here all the output for the default initialisation
      write(unit=ninfout_cll,fmt=*) '                                                          '
      write(unit=ninfout_cll,fmt=*) '***********************************************************'
      write(unit=ninfout_cll,fmt=*) '  Default initialization of COLLIER:                     '
      write(unit=ninfout_cll,fmt=fmt90) '    COLLIER mode: mode_cll =           ',mode_cll
      select case (mode_cll)
      case (1)
        write(ninfout_cll,*) '      -> use COLI implementation'
      case (2)
        write(ninfout_cll,*) '      -> use DD implementation'
      case (3)
        write(ninfout_cll,*) '      -> check COLI against DD implementation'
      end select
      write(unit=ninfout_cll,fmt=*) '-----------------------------------------------------------'
      write(unit=ninfout_cll,fmt=*) '    internal parameters:                                   '
      write(unit=ninfout_cll,fmt=fmt90) '    maximal degree:     Nmax         = ',nmax
      write(unit=ninfout_cll,fmt=fmt91) '    UV scale:           muUV2        = ',muuv2
      write(unit=ninfout_cll,fmt=fmt91) '    IR scale:           muIR2        = ',muir2
      write(unit=ninfout_cll,fmt=fmt91) '    UV pole:            deltaUV      = ',deltauv 
      write(unit=ninfout_cll,fmt=fmt91) '    single IR pole:     deltaIR1     = ',deltair1 
      write(unit=ninfout_cll,fmt=fmt91) '    double IR pole:     deltaIR2     = ',deltair2 
      write(unit=ninfout_cll,fmt=fmt91) '    target precision:   reqacc_cll   = ',reqacc_cll 
      write(unit=ninfout_cll,fmt=fmt91) '    critical precision: critacc_cll  = ',critacc_cll 
      write(unit=ninfout_cll,fmt=fmt91) '    check precision:    checkacc_cll = ',checkacc_cll 
      write(unit=ninfout_cll,fmt=fmt91) '    est. CPU precision: dprec_cll    = ',dprec_cll 
      write(unit=ninfout_cll,fmt=fmt90) '    maximal rank of Bs: ritmaxB      = ',ritmaxb
      write(unit=ninfout_cll,fmt=fmt90) '    maximal rank of Cs: ritmaxC      = ',ritmaxc
      write(unit=ninfout_cll,fmt=fmt90) '    maximal rank of Ds: ritmaxD      = ',ritmaxd
      write(unit=ninfout_cll,fmt=fmt90) '    stop forced for ErrorStop_cll   <= ',errorstop_cll
      write(unit=ninfout_cll,fmt=*) '-----------------------------------------------------------'
 
    if (allocated(minf2_cll)) then
        write(unit=ninfout_cll,fmt=*) '    list of infinitesimal masses:'
      do i=1,size(minf2_cll)
        write(unit=ninfout_cll,fmt=fmt98) i,real(minf2_cll(i))
      end do
    end if
  
         
    if (.not.allocated(minf2_cll)) then
        write(unit=ninfout_cll,fmt=*) '    list of infinitesimal masses cleared'
    end if
 
 
      if (ir_rational_terms_cll) then
        write(unit=ninfout_cll,fmt=*) '    IR rational terms switched on'
      else
        write(unit=ninfout_cll,fmt=*) '    IR rational terms switched off'
      end if
 
      if (calcuv_cll) then
        write(unit=ninfout_cll,fmt=*) '    UV terms for tensors switched on'
      else
        write(unit=ninfout_cll,fmt=*) '    UV terms for tensors switched off'
      end if
 
      if (tenred_cll.eq.never_tenred_cll) then
        write(unit=ninfout_cll,fmt=*) '    direct tensor reduction switched off'  
      else
        write(unit=ninfout_cll,fmt=fmt90) '    direct tensor reduction for   N >= ',tenred_cll
      end if
 
      write(unit=ninfout_cll,fmt=*) '-----------------------------------------------------------'
      if (use_cache_system) then
        write(unit=ninfout_cll,fmt=*) '    cache system switched on'
        write(unit=ninfout_cll,fmt=fmt90) '    initialized caches: ncache_max   = ',ncache_max
        do i=1,ncache_max
          if (cache_mode(i).eq.-1) then
            write(unit=ninfout_cll,fmt=fmt96) i     
          else
            write(unit=ninfout_cll,fmt=fmt97) i
          end if
        end do
      else
        write(unit=ninfout_cll,fmt=*) '    cache system switched off'
      end if
 
      write(unit=ninfout_cll,fmt=*) '                                                           '
      write(unit=ninfout_cll,fmt=*) '***********************************************************'
      write(unit=ninfout_cll,fmt=*) '                                                           '     
    end if
    
    end if
    
  end subroutine init_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Reset_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine reset_cll
    logical :: qopened
 
 
    if (.not.nofiles_cll) then
      if(ninfout_cll.ne.closed_cll) then
        inquire(ninfout_cll, opened=qopened)
        if(qopened.and.ninfout_cll.ne.stdout_cll) close(unit=ninfout_cll)
      end if
 
      if(ninfoutcoli_cll.ne.closed_cll) then
        inquire(ninfoutcoli_cll, opened=qopened)
        if(qopened.and.ninfoutcoli_cll.ne.stdout_cll) close(unit=ninfoutcoli_cll)
      end if
 
      if(nerrout_cll.ne.closed_cll) then
        inquire(nerrout_cll, opened=qopened)
        if(qopened.and.nerrout_cll.ne.stdout_cll) close(unit=nerrout_cll)
      end if
 
      if(nerroutcoli_cll.ne.closed_cll) then
        inquire(nerroutcoli_cll, opened=qopened)
        if(qopened.and.nerroutcoli_cll.ne.stdout_cll) close(unit=nerroutcoli_cll)
      end if
    
      if(nerroutdd_cll.ne.closed_cll) then
        inquire(nerroutdd_cll, opened=qopened)
        if(qopened.and.nerroutdd_cll.ne.stdout_cll) close(unit=nerroutdd_cll)
      end if
    
      if(ncheckout_cll.ne.closed_cll) then
        inquire(ncheckout_cll, opened=qopened)
        if(qopened.and.ncheckout_cll.ne.stdout_cll) close(unit=ncheckout_cll)
      end if
 
      if(ncpout_cll.ne.closed_cll) then
        inquire(ncpout_cll, opened=qopened)
        if(qopened.and.ncpout_cll.ne.stdout_cll) close(unit=ncpout_cll)
      end if
 
      if(ncpout2_cll.ne.closed_cll) then
        inquire(ncpout2_cll, opened=qopened)
        if(qopened.and.ncpout2_cll.ne.stdout_cll) close(unit=ncpout2_cll)
      end if
 
      if(ncpoutcoli_cll.ne.closed_cll) then
        inquire(ncpoutcoli_cll, opened=qopened)
        if(qopened.and.ncpoutcoli_cll.ne.stdout_cll) close(unit=ncpoutcoli_cll)
      end if
 
      if(nstatsoutcoli_cll.ne.closed_cll) then
        inquire(nstatsoutcoli_cll, opened=qopened)
        if(qopened.and.nstatsoutcoli_cll.ne.stdout_cll) close(unit=nstatsoutcoli_cll)
      end if
    end if
    
    if(allocated(minf2_cll)) deallocate(minf2_cll)
    if(allocated(pointscnttn_cll)) deallocate(pointscnttn_cll)
    if(allocated(critpointscnttn_cll)) deallocate(critpointscnttn_cll)
    if(allocated(accpointscnttn_cll)) deallocate(accpointscnttn_cll)
    if(allocated(pointscnttn2_cll)) deallocate(pointscnttn2_cll)
    if(allocated(critpointscnttn2_cll)) deallocate(critpointscnttn2_cll)
    if(allocated(accpointscnttn2_cll)) deallocate(accpointscnttn2_cll)
    if(allocated(pointscnttnten_cll)) deallocate(pointscnttnten_cll)
    if(allocated(critpointscnttnten_cll)) deallocate(critpointscnttnten_cll)
    if(allocated(accpointscnttnten_cll)) deallocate(accpointscnttnten_cll)
    if(allocated(pointscnttn_coli)) deallocate(pointscnttn_coli)
    if(allocated(pointscnttn_dd)) deallocate(pointscnttn_dd)
    if(allocated(pointscnttnten_coli)) deallocate(pointscnttnten_coli)
    if(allocated(pointscnttnten_dd)) deallocate(pointscnttnten_dd)
    if(allocated(maxcheck_cll)) deallocate(maxcheck_cll)
    if(allocated(checkcnt_cll)) deallocate(checkcnt_cll)
    if(allocated(diffcnt_cll)) deallocate(diffcnt_cll)
    if(allocated(checkcntten_cll)) deallocate(checkcntten_cll)
    if(allocated(diffcntten_cll)) deallocate(diffcntten_cll)
 
 
  end subroutine reset_cll
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitEvent_cll(Ncache)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initevent_cll(Ncache)
 
    integer, optional, intent(in) :: Ncache
    integer :: nc,errflag
 
    if (present(ncache)) then
      nc = ncache
    else
      nc = 1
    end if
 
    if (monitoring) then
      erreventcnt(1)           = erreventcnt(1)           + 1
      erreventcnt(errflag_cll) = erreventcnt(errflag_cll) + 1
      acceventcnt(1)           = acceventcnt(1)           + 1
      acceventcnt(accflag_cll) = acceventcnt(accflag_cll) + 1
    end if
 
    if (use_cache_system) then
      call initcache_cll(nc)
    end if
    call initerrflag_cll
    call initaccflag_cll
    eventcnt_cll = eventcnt_cll+1
 
  end subroutine initevent_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetVersionNumber_cll(version)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getversionnumber_cll(version)
 
    character(len=5) :: version
    
    version = version_cll
 
  end subroutine getversionnumber_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitEventCnt_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initeventcnt_cll()
 
    logical :: infwri
  
    eventcnt_cll = 0
 
    if (infoutlev_cll.ge.2) call infout_cll('InitEventCnt_cll','phase-space point counter set to zero',infwri)
 
  end subroutine initeventcnt_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetEventCnt_cll(event)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine geteventcnt_cll(event)
 
    integer :: event
    
    event = eventcnt_cll
 
  end subroutine geteventcnt_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMode_cll(mode)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmode_cll(mode)
 
    integer, intent(in) :: mode
    integer :: ritmax
    logical :: infwri
    
    if ((mode.lt.1).or.(mode.gt.3)) then
      write(nerrout_cll,*) 'COLLIER: mode_cll must be set to one of the following values'
      write(nerrout_cll,*) '1: use COLI-implementation'
      write(nerrout_cll,*) '2: use DD-implementation'
      write(nerrout_cll,*) '3: check COLI- against DD-implementation'
      if (errorstop_cll.ge.-10) stop
 
    end if
 
    mode_cll = mode
 
    infwri = .false.
    if (infoutlev_cll.ge.1) call infout_cll('SetMode_cll','mode_cll set to',infwri)
 
    select case (mode_cll)
    case (1)
      if (infwri) write(ninfout_cll,*) ' 1 --> use COLI implementation'
      
      if (nerroutcoli_cll.eq.closed_cll) then
        call openerroutfilecoli_cll(trim(foldername_cll)//'/ErrOut.coli')
      end if
      
    case (2)
      if (infwri) write(ninfout_cll,*) ' 2 --> use DD implementation'
      
      if (nerroutdd_cll.eq.closed_cll) then
        call openerroutfiledd_cll(trim(foldername_cll)//'/ErrOut.dd')
        call getritmax_cll(ritmax)
        call setritmax_cll(ritmax)
      end if
      
    case (3)
      
      if (infwri) write(ninfout_cll,*) ' 3 --> check COLI against DD implementation'
      
      if (nerroutcoli_cll.eq.closed_cll) then
        call openerroutfilecoli_cll(trim(foldername_cll)//'/ErrOut.coli')
      end if
      
      if (nerroutdd_cll.eq.closed_cll) then
        call openerroutfiledd_cll(trim(foldername_cll)//'/ErrOut.dd')
        call getritmax_cll(ritmax)
        call setritmax_cll(ritmax)
      end if
      
      if (ncheckout_cll.eq.closed_cll) then
        call opencheckoutfile_cll(trim(foldername_cll)//'/CheckOut.cll')
      endif
      
    end select
 
  end subroutine setmode_cll
 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetMode_cll(mode)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getmode_cll(mode)
 
    integer, intent(out) :: mode
 
    mode = mode_cll
 
  end subroutine getmode_cll
 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMuUV2_cll(mu2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmuuv2_cll(mu2)
 
    double precision, intent(in) :: mu2
    double precision :: DeltaUV_dd,DeltaIR2_dd,DeltaIR1_dd
    double precision :: muUV2_dd,muIR2_dd,xmx2_dd(nminf_colidd)
    integer :: i
    logical :: infwri
    character(len=*),parameter :: fmt11 = "(A11,d25.18)"
 
    muuv2_cll = mu2
 
    ! set muuv2 in COLI
    call setmuuv2_coli(muuv2_cll)
 
    ! set muv2 in DD
    call ddgetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
    call ddsetparam(deltauv_dd,muuv2_cll,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
 
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetMuUV2_cll','UV scale set to',infwri)
    if(infwri) write(ninfout_cll,fmt11) '   muUV2 =', muuv2_cll
    
 
  end subroutine setmuuv2_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetMuUV2_cll(mu2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getmuuv2_cll(mu2)
 
    double precision, intent(out) :: mu2
 
    mu2 = muuv2_cll
 
  end subroutine getmuuv2_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMuIR2_cll(mu2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmuir2_cll(mu2)
 
    double precision, intent(in) :: mu2
    double precision :: DeltaUV_dd,DeltaIR2_dd,DeltaIR1_dd
    double precision :: muUV2_dd,muIR2_dd,xmx2_dd(nminf_colidd)
    integer :: i
    logical :: infwri
    character(len=*),parameter :: fmt11 = "(A11,d25.18)"
 
    muir2_cll = mu2
 
    ! set muir2 in COLI
    call setmuir2_coli(muir2_cll)
 
    ! set muir2 in DD
    call ddgetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
    call ddsetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_cll,xmx2_dd)
    
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetMuIR2_cll','IR scale set to',infwri)
    if(infwri) write(ninfout_cll,fmt11) '   muIR2 =', muir2_cll
 
  end subroutine setmuir2_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetMuIR2_cll(mu2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getmuir2_cll(mu2)
 
    double precision, intent(out) :: mu2
 
    mu2 = muir2_cll
 
  end subroutine getmuir2_cll
 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetDeltaUV_cll(delta)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setdeltauv_cll(delta)
 
    double precision, intent(in) :: delta
    double precision :: DeltaUV_dd,DeltaIR2_dd,DeltaIR1_dd
    double precision :: muUV2_dd,muIR2_dd,xmx2_dd(nminf_colidd)
    integer :: i
    logical :: infwri
    character(len=*),parameter :: fmt13 = "(A13,d25.18)"
#include "COLI/global_coli.h"
 
#ifdef SING
    deltauv_cll = delta
#else
    deltauv_cll = 0d0
    if (erroutlev_cll.ge.1) then
      write(nerrout_cll,*) 'preprocessor flag SING = false' 
      write(nerrout_cll,*) 'call of SetDeltaUV_cll without effect'
    end if   
#endif
 
#ifdef SING
    ! set deltauv in COLI
    call setdeltauv_coli(deltauv_cll)
#endif
 
    ! set deltauv in DD
    call ddgetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
    call ddsetparam(deltauv_cll,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
 
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetDeltaUV_cll','UV pole set to',infwri)
    if(infwri) write(ninfout_cll,fmt13) '    deltaUV =', deltauv_cll  
 
  end subroutine setdeltauv_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetDeltaUV_cll(delta)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getdeltauv_cll(delta)
 
    double precision, intent(out) :: delta
 
    delta = deltauv_cll
 
  end subroutine getdeltauv_cll
 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetDeltaIR_cll(delta1,delta2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setdeltair_cll(delta1,delta2)
 
    double precision, intent(in) :: delta1,delta2
    double precision :: DeltaUV_dd,DeltaIR2_dd,DeltaIR1_dd
    double precision :: muUV2_dd,muIR2_dd,xmx2_dd(nminf_colidd)
    integer :: i
    logical :: infwri
    character(len=*),parameter :: fmt14 = "(A14,d25.18)"
#include "COLI/global_coli.h"
 
#ifdef SING
    deltair1_cll = delta1
    deltair2_cll = delta2
#else
    deltair1_cll = 0d0
    deltair2_cll = 0d0
    if (erroutlev_cll.ge.1) then
      write(nerrout_cll,*) 'preprocessor flag SING = false'
      write(nerrout_cll,*) 'call of SetDeltaUV_cll without effect'
    end if 
#endif
 
#ifdef SING
    ! set deltauv in COLI
    call setdeltair_coli(deltair1_cll,deltair2_cll)
#endif
    ! set deltauv in DD
    call ddgetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
    call ddsetparam(deltauv_dd,muuv2_dd,deltair2_cll,  &
             deltair1_cll,muir2_dd,xmx2_dd)
 
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetDeltaIR_cll','IR single and double pole set to',infwri)
    if(infwri) then
      write(ninfout_cll,fmt14) '    deltaIR1 =', deltair1_cll
      write(ninfout_cll,fmt14) '    deltaIR2 =', deltair2_cll      
    end if
 
  end subroutine setdeltair_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetDeltaIR_cll(delta1,delta2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getdeltair_cll(delta1,delta2)
 
    double precision, intent(out) :: delta1,delta2
 
    delta1 = deltair1_cll
    delta2 = deltair2_cll
 
  end subroutine getdeltair_cll
 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine AddMinf2_cll(m2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine addminf2_cll(m2)
 
    double complex, intent(in) :: m2
    double complex, allocatable :: minf2_cp(:)
    double precision :: DeltaUV_dd,DeltaIR2_dd,DeltaIR1_dd
    double precision :: muUV2_dd,muIR2_dd,xmx2_dd(nminf_colidd)
    double precision :: xmx2(nminf_colidd)
    integer :: i
    logical :: infwri
    character(len=*),parameter :: fmt92 = "(A10,I3,A4,'dcmplx(',d25.18,' ,',d25.18,' )')"
 
    if(m2.eq.0d0) then
      if (infoutlev_cll.ge.1) call infout_cll('AddMinf2_cll','zero cannot be added to list of infinitesimal masses:',infwri)
      return
    end if
    
    if (nminf_cll.eq.0) then
      nminf_cll = 1
      if (allocated(minf2_cll)) then
        deallocate(minf2_cll)
      end if
      allocate(minf2_cll(nminf_cll))
 
      minf2_cll(1) = m2
 
    else
      do i=1,nminf_cll
        if (m2.eq.minf2_cll(i)) return
      end do
 
      allocate(minf2_cp(nminf_cll))
      minf2_cp = minf2_cll
 
      nminf_cll = nminf_cll+1
      if (allocated(minf2_cll)) then
        deallocate(minf2_cll)
      end if
 
      allocate(minf2_cll(nminf_cll))
      minf2_cll(1:nminf_cll-1) = minf2_cp
      minf2_cll(nminf_cll) = m2
 
    end if
 
    ! add m2 to small masses in COLI
    call setminf2_coli(minf2_cll(nminf_cll))
 
    ! add m2 to small masses in DD
    if (nminf_cll.gt.nminf_colidd) then
      if (erroutlev_cll.ge.1) then
        write(nerrout_cll,*) 'COLLIER: more than' , nminf_colidd,' different infinitesimal masses not supported by DD'
      end if
      if (errorstop_cll.ge.-10) stop
    end if
 
    xmx2 = 0d0
    do i=1,nminf_cll
      xmx2(i) = dreal(minf2_cll(i))
    end do
 
    call ddgetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
    call ddsetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
                    deltair1_dd,muir2_dd,xmx2)
    
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('AddMinf2_cll','added to list of infinitesimal masses:',infwri)
    if(infwri) write(ninfout_cll,fmt92) '    minf2(',nminf_cll,') = ',minf2_cll(nminf_cll) 
 
  end subroutine addminf2_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine clearminf2_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine clearminf2_cll
 
    double precision :: xmx2(nminf_colidd)
    double precision :: DeltaUV_dd,DeltaIR2_dd,DeltaIR1_dd
    double precision :: muUV2_dd,muIR2_dd,xmx2_dd(nminf_colidd)
    integer :: i
    logical :: infwri
 
    nminf_cll = 0
    if (allocated(minf2_cll)) then
      deallocate(minf2_cll)
    end if
 
    ! clear list of small masses in COLI
    call clearcoliminf2
 
    ! clear list of small masses in DD
    xmx2 = 0d0
 
    call ddgetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
             deltair1_dd,muir2_dd,xmx2_dd)
    call ddsetparam(deltauv_dd,muuv2_dd,deltair2_dd,  &
                    deltair1_dd,muir2_dd,xmx2)
 
    if (infoutlev_cll.ge.2) call infout_cll('clearminf2_cll','list of infinitesimal masses cleared',infwri)                   
 
 
  end subroutine clearminf2_cll
 
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setminf2_cll(nminf,minf2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setminf2_cll(nminf,minf2)
 
    integer, intent(in) :: nminf
    double complex, intent(in) :: minf2(nminf)
    integer :: i
 
    call clearminf2_cll
 
    do i=1,nminf
      call addminf2_cll(minf2(i))
    end do
 
  end subroutine setminf2_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetNminf_cll(nminf)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getnminf_cll(nminf)
 
    integer, intent(out) :: nminf
 
    nminf = nminf_cll
 
  end subroutine getnminf_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Getminf2_cll(minf2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getminf2_cll(minf2)
 
    double complex, intent(out) :: minf2(nminf_cll)
 
    minf2 = minf2_cll
 
  end subroutine getminf2_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  function Getminf2DD_cll(m2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  function getminf2dd_cll(m2)  result(minf2DD)
 
    double complex :: m2, minf2dd
    integer :: i
 
    do i=1,nminf_cll
      if (m2.eq.minf2_cll(i)) then
        minf2dd = i*1d-20
        return
      end if
    end do
    minf2dd = m2
 
  end function getminf2dd_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  function GetNc_cll(N,r)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
 
  function getnc_cll(N,r) result(Nc)
  
    integer :: nc
    integer :: n,r
    
    if ((n.gt.nmax_cll).or.(n.lt.1).or.(r.gt.rmaxb_cll).or.(r.lt.1)) then
      if (erroutlev_cll.ge.1) then
        write(nerrout_cll,*) 'GetNc: argument N=',n,' or r=',r,' out of bound'
      end if
      nc=0
      return
    end if
    nc = ncoefs(r,n)
    
  end function getnc_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  function GetNt_cll(r)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
 
  function getnt_cll(r) result(Nt)
  
    integer :: nt
    integer :: r
    
    if ((r.gt.rmaxb_cll).or.(r.lt.1)) then
      if (erroutlev_cll.ge.1) then
        write(nerrout_cll,*) 'GetNt: argument r=',r,' out of bound'
      end if
      nt=0
      return
    end if
    nt = rts(r)
    
  end function getnt_cll
  
  
  
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOffIRrational_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchoffirrational_cll()
  
    logical :: infwri
 
    ir_rational_terms_cll = .false.
    call unsetirratterms_coli
 
    if (infoutlev_cll.ge.2) call infout_cll('SwitchOffIRrational_cll','IR rational terms switched off in COLI',infwri)
 
 
  end subroutine switchoffirrational_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOnIRrational_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchonirrational_cll()
 
    ir_rational_terms_cll = .true.
    call setirratterms_coli
    if (infoutlev_cll.ge.2) then
      write(ninfout_cll,*) 'COLLIER: IR rational terms switched on'
    end if
 
  end subroutine switchonirrational_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOffCalcUV_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchoffcalcuv_cll()
 
    calcuv_cll = .false.
    call switchoffcalcuv_ten()
 
  end subroutine switchoffcalcuv_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOnCalcUV_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchoncalcuv_cll()
 
    calcuv_cll = .true.
    call switchoncalcuv_ten()
 
  end subroutine switchoncalcuv_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetCalcUV_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getcalcuv_cll(CalcUV)
 
    logical, intent(out) :: CalcUV
 
    calcuv = calcuv_cll
 
  end subroutine getcalcuv_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetTenRed_cll(tenred)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine settenred_cll(tenred)
 
    integer, intent(in) :: tenred
    logical :: infwri,fla
    
    if (tenred.le.5) then
      call errout_cll('SetTenRed_cll','Ntenred cannot be chosen smaller than 6',fla,.true.)
      if (fla) then
        write(nerrout_cll,*) 'Ntenred is set to Ntenred = 6'
      end if
      tenred_cll = 6
    else
      tenred_cll = tenred
    end if
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetTenRed_cll','direct tensor reduction switched on for',infwri)    
    if(infwri)  write(ninfout_cll,*) '    N >= ',tenred
 
  end subroutine settenred_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOnTenRed_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchontenred_cll()
 
    logical :: infwri
  
    tenred_cll = 6
    if (infoutlev_cll.ge.2) call infout_cll('SwitchOnTenRed_cll','direct tensor reduction switched on for N >= 6',infwri)     
 
  end subroutine switchontenred_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOffTenRed_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchofftenred_cll()
  
    logical :: infwri
 
    tenred_cll = never_tenred_cll
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SwitchOffTenRed_cll','direct tensor reduction switched off',infwri)    
 
  end subroutine switchofftenred_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetTenRed_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine gettenred_cll(tenred)
 
    integer, intent(out) :: tenred
 
    tenred = tenred_cll
 
  end subroutine gettenred_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOffErrStop_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchofferrstop_cll()
 
    errorstop_cll = -20
 
  end subroutine switchofferrstop_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetErrStop_cll(errstop)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine seterrstop_cll(errstop)
    integer :: errstop
 
    errorstop_cll = errstop
 
  end subroutine seterrstop_cll
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetErrStop_cll(errstop)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine geterrstop_cll(errstop)
    integer :: errstop
 
    errstop = errorstop_cll
 
  end subroutine geterrstop_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOffFileOutput_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchofffileoutput_cll
    logical :: qopened
 
    if(nofiles_cll) return
    
    if(ninfout_cll.ne.closed_cll) then
      inquire(ninfout_cll, opened=qopened)
      if(qopened.and.ninfout_cll.ne.stdout_cll) close(unit=ninfout_cll)
    end if
 
    if(ninfoutcoli_cll.ne.closed_cll) then
      inquire(ninfoutcoli_cll, opened=qopened)
      if(qopened.and.ninfoutcoli_cll.ne.stdout_cll) close(unit=ninfoutcoli_cll)
    end if
 
    if(nerrout_cll.ne.closed_cll) then
      inquire(nerrout_cll, opened=qopened)
      if(qopened.and.nerrout_cll.ne.stdout_cll) close(unit=nerrout_cll)
    end if
 
    if(nerroutcoli_cll.ne.closed_cll) then
      inquire(nerroutcoli_cll, opened=qopened)
      if(qopened.and.nerroutcoli_cll.ne.stdout_cll) close(unit=nerroutcoli_cll)
    end if
    
    if(nerroutdd_cll.ne.closed_cll) then
      inquire(nerroutdd_cll, opened=qopened)
      if(qopened.and.nerroutdd_cll.ne.stdout_cll) close(unit=nerroutdd_cll)
    end if
    
    if(ncheckout_cll.ne.closed_cll) then
      inquire(ncheckout_cll, opened=qopened)
      if(qopened.and.ncheckout_cll.ne.stdout_cll) close(unit=ncheckout_cll)
    end if
 
    if(ncpout_cll.ne.closed_cll) then
      inquire(ncpout_cll, opened=qopened)
      if(qopened.and.ncpout_cll.ne.stdout_cll) close(unit=ncpout_cll)
    end if
 
    if(ncpout2_cll.ne.closed_cll) then
      inquire(ncpout2_cll, opened=qopened)
      if(qopened.and.ncpout2_cll.ne.stdout_cll) close(unit=ncpout2_cll)
    end if
 
    if(ncpoutcoli_cll.ne.closed_cll) then
      inquire(ncpoutcoli_cll, opened=qopened)
      if(qopened.and.ncpoutcoli_cll.ne.stdout_cll) close(unit=ncpoutcoli_cll)
    end if
 
    if(nstatsoutcoli_cll.ne.closed_cll) then
      inquire(nstatsoutcoli_cll, opened=qopened)
      if(qopened.and.nstatsoutcoli_cll.ne.stdout_cll) close(unit=nstatsoutcoli_cll)
    end if
    
 
    nerrout_cp_cll = nerrout_cll
    fname_errout_cp_cll = fname_errout_cll   
    nerroutcoli_cp_cll = nerroutcoli_cll    
    fname_erroutcoli_cp_cll = fname_erroutcoli_cll
    nerroutdd_cp_cll = nerroutdd_cll
    fname_erroutdd_cp_cll = fname_erroutdd_cll
    ninfout_cp_cll = ninfout_cll
    fname_infout_cp_cll = fname_infout_cll
    ninfoutcoli_cp_cll = ninfoutcoli_cll    
    fname_infoutcoli_cp_cll = fname_infoutcoli_cll 
    ncheckout_cp_cll = ncheckout_cll
    fname_checkout_cp_cll = fname_checkout_cll
    ncpoutcoli_cp_cll = ncpoutcoli_cll
    fname_cpoutcoli_cp_cll = fname_cpoutcoli_cll
    ncpout_cp_cll = ncpout_cll
    fname_cpout_cp_cll = fname_cpout_cll
    ncpout2_cp_cll = ncpout2_cll
    fname_cpout2_cp_cll = fname_cpout2_cll
    nstatsoutcoli_cp_cll = nstatsoutcoli_cll    
    fname_statsoutcoli_cp_cll = fname_statsoutcoli_cll 
 
    nofiles_cll = .true.
    call initoutchan_cll(.false.)
    
 
  end subroutine switchofffileoutput_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SwitchOnFileOutput_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine switchonfileoutput_cll
 
    logical :: qopened
 
    if(.not.nofiles_cll) return
    nofiles_cll = .false.
 
    fname_errout_cll = fname_errout_cp_cll
    if ((nerrout_cp_cll.ne.closed_cll).and.(nerrout_cp_cll.ne.stdout_cll)) then
      inquire(nerrout_cp_cll, opened=qopened)
      if (qopened) then
        call setnerrout_cll
      else
        call setnerrout_cll(nerrout_cp_cll)
      end if    
    end if
    
    fname_erroutcoli_cll = fname_erroutcoli_cp_cll
    if ((nerroutcoli_cp_cll.ne.closed_cll).and.(nerroutcoli_cp_cll.ne.stdout_cll)) then
      inquire(nerroutcoli_cp_cll, opened=qopened)
      if (qopened) then
        call setnerroutcoli_cll
      else
        call setnerroutcoli_cll(nerroutcoli_cp_cll)
      end if    
    end if    
    
    fname_erroutdd_cll = fname_erroutdd_cp_cll
    if ((nerroutdd_cp_cll.ne.closed_cll).and.(nerroutdd_cp_cll.ne.stdout_cll)) then
      inquire(nerroutdd_cp_cll, opened=qopened)
      if (qopened) then
        call setnerroutdd_cll
      else
        call setnerroutdd_cll(nerroutdd_cp_cll)
      end if    
    end if     
 
    fname_infout_cll = fname_infout_cp_cll
    if ((ninfout_cp_cll.ne.closed_cll).and.(ninfout_cp_cll.ne.stdout_cll)) then
      inquire(ninfout_cp_cll, opened=qopened)
      if (qopened) then
        call setninfout_cll
      else
        call setninfout_cll(ninfout_cp_cll)
      end if
    end if
 
    fname_infoutcoli_cll = fname_infoutcoli_cp_cll
    if ((ninfoutcoli_cp_cll.ne.closed_cll).and.(ninfoutcoli_cp_cll.ne.stdout_cll)) then
      inquire(ninfoutcoli_cp_cll, opened=qopened)
      if (qopened) then
        call setninfoutcoli_cll
      else
        call setninfoutcoli_cll(ninfoutcoli_cp_cll)
      end if
    end if
  
    fname_checkout_cll = fname_checkout_cp_cll
    if ((ncheckout_cp_cll.ne.closed_cll).and.(ncheckout_cp_cll.ne.stdout_cll)) then
      inquire(ncheckout_cp_cll, opened=qopened)
      if (qopened) then
        call setncheckout_cll
      else
        call setncheckout_cll(ncheckout_cp_cll)
      end if
    end if
  
    fname_cpoutcoli_cll = fname_cpoutcoli_cp_cll
    if ((ncpoutcoli_cp_cll.ne.closed_cll).and.(ncpoutcoli_cp_cll.ne.stdout_cll)) then
      inquire(ncpoutcoli_cp_cll, opened=qopened)
      if (qopened) then
        call setncpoutcoli_cll
      else
        call setncpoutcoli_cll(ncpoutcoli_cp_cll)
      end if
    end if    
  
    fname_cpout_cll = fname_cpout_cp_cll
    if ((ncpout_cp_cll.ne.closed_cll).and.(ncpout_cp_cll.ne.stdout_cll)) then
      inquire(ncpout_cp_cll, opened=qopened)
      if (qopened) then
        call setncritpointsout_cll
      else
        call setncritpointsout_cll(ncpout_cp_cll)
      end if
    end if 
  
    fname_cpout2_cll = fname_cpout2_cp_cll
    if ((ncpout2_cp_cll.ne.closed_cll).and.(ncpout2_cp_cll.ne.stdout_cll)) then
      inquire(ncpout2_cp_cll, opened=qopened)
      if (qopened) then
        call setncritpointsout2_cll
      else
        call setncritpointsout2_cll(ncpout2_cp_cll)
      end if
    end if
  
    fname_statsoutcoli_cll = fname_statsoutcoli_cp_cll
    if ((nstatsoutcoli_cp_cll.ne.closed_cll).and.(nstatsoutcoli_cp_cll.ne.stdout_cll)) then
      inquire(nstatsoutcoli_cp_cll, opened=qopened)
      if (qopened) then
        call setnstatsoutcoli_cll
      else
        call setnstatsoutcoli_cll(nstatsoutcoli_cp_cll)
      end if
    end if    
   
 
  end subroutine switchonfileoutput_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetInfoutlev_cll(infoutlev)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setinfoutlev_cll(infoutlev)
 
    integer, intent(in) :: infoutlev
 
    infoutlev_cll = infoutlev
    call setinfoutlev_cache(infoutlev)
 
  end subroutine setinfoutlev_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetInfoutlev_cll(infoutlev)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getinfoutlev_cll(infoutlev)
 
    integer, intent(out) :: infoutlev
 
    infoutlev = infoutlev_cll
 
  end subroutine getinfoutlev_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetErroutlev_cll(erroutlev)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine seterroutlev_cll(erroutlev)
 
    integer, intent(in) :: erroutlev
   
    if (erroutlev.eq.0) then
      call ddsetcout_on(.false.)   
    else if(erroutlev.eq.1) then
      if(nerroutdd_cll.ne.closed_cll) then
        call ddsetcout_on(.true.)
      end if
    else
      return
    end if
    erroutlev_cll = erroutlev
    call seterroutlev_coli(erroutlev)
 
  end subroutine seterroutlev_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetErroutlev_cll(erroutlev)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine geterroutlev_cll(erroutlev)
 
    integer, intent(out) :: erroutlev
 
    erroutlev = erroutlev_cll
 
  end subroutine geterroutlev_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitGlobalDD_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initglobaldd_cll(nmax_cll,ritmax_cll)
 
    integer, intent(in) :: nmax_cll,ritmax_cll
    integer :: nmax,rmax,rmax2,rmax3,rmax4,rmax5,rmax6
    integer :: outlevel_dd,outchannel_dd,mode34_dd,mode5_dd,mode6_dd
    double precision :: cacc_dd,dacc_dd
 
    call init_dd_global(nmax_cll,ritmax_cll)
 
    call ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
    call ddsetmode(cacc_dd,dacc_dd,2,0,0,0,outchannel_dd)
    call ddgetglobal(nmax,rmax,rmax2,rmax3,  &
                     rmax4,rmax5,rmax6)
 
    nmax_dd = nmax
    rmax_dd = rmax
    rmax2_dd = rmax2
    rmax3_dd = rmax3
    rmax4_dd = rmax4
    rmax5_dd = rmax5
    rmax6_dd = rmax6
 
  end subroutine initglobaldd_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetCPUprec_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getcpuprec_cll
 
    double precision :: dprec, dres_old, dres
    integer :: i
    logical :: infwri
 
    dprec = 1d0
    dres_old = 2d0    
    do i=1,1000
      dprec = dprec/2d0
      dres = exp(log(1d0+dprec))
      if (abs(dres).ge.abs(dres_old)) exit
      dres_old = dres
    end do
    dprec_cll = dprec*8d0
 
    call setprec_coli(dprec_cll)
 
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('GetCPUprec_cll','estimator of CPU double precision set to',infwri)    
    if(infwri)  write(ninfout_cll,*) '    dprec =', dprec_cll    
 
  end subroutine getcpuprec_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetAccuracy(acc0,acc1,acc2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setaccuracy_cll(acc0,acc1,acc2)
 
    double precision :: acc0, acc1, acc2
    integer :: outlevel_dd,outchannel_dd,mode34_dd,mode5_dd,mode6_dd
    double precision :: cacc_dd,dacc_dd
    logical :: qopened,infwri
    character(len=*),parameter :: fmt27 = "(A27,Es17.10)"
    character(len=*),parameter :: fmt31 = "(A31,Es17.10)"
    character(len=*),parameter :: fmt33 = "(A33,Es17.10)"
    character(len=*),parameter :: fmt45 = "(A45,Es17.10)"
    
    reqacc_cll = acc0
    critacc_cll = acc1
    checkacc_cll = acc2
 
    call ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
    call ddsetmode(reqacc_cll,reqacc_cll,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
    call setacc_coli(acc0,acc1)
 
    if (infoutlev_cll.ge.2) then
      infwri = .false.
      if (infoutlev_cll.ge.2) call infout_cll('SetAccuracy_cll','precisions set to',infwri)    
      if(infwri) write(ninfout_cll,fmt31) 'target precision:    acc0 =', reqacc_cll
      if(infwri) write(ninfout_cll,fmt31) 'critical precision:  acc1 =', critacc_cll
      if(infwri) write(ninfout_cll,fmt31) 'check precision:     acc2 =', checkacc_cll
    end if
 
    if(ncpout_cll.ne.closed_cll) then
      inquire(ncpout_cll, opened=qopened)
      if(qopened) then
        write(unit=ncpout_cll,fmt=*) '                                                          '
        write(unit=ncpout_cll,fmt=*) '***********************************************************'
        write(unit=ncpout_cll,fmt=*) ' critical precision set to critacc =', critacc_cll 
        write(unit=ncpout_cll,fmt=*) '***********************************************************'
        write(unit=ncpout_cll,fmt=*) '                                                          '
      endif
    end if
 
    if(ncpout2_cll.ne.closed_cll) then
      inquire(ncpout2_cll, opened=qopened)
      if(qopened) then
        write(unit=ncpout2_cll,fmt=*) '                                                          '
        write(unit=ncpout2_cll,fmt=*) '***********************************************************'
        write(unit=ncpout2_cll,fmt=*) ' critical precision set to critacc =', critacc_cll 
        write(unit=ncpout2_cll,fmt=*) '***********************************************************'
        write(unit=ncpout2_cll,fmt=*) '                                                          '
      endif
    end if
      
    if(ncpoutcoli_cll.ne.closed_cll) then     
      inquire(ncpoutcoli_cll, opened=qopened)  
      if(qopened) then
        write(unit=ncpoutcoli_cll,fmt=*) '                                                          '
        write(unit=ncpoutcoli_cll,fmt=*) '***********************************************************'
        write(unit=ncpoutcoli_cll,fmt=*) ' critical precision set to critacc =', critacc_cll 
        write(unit=ncpoutcoli_cll,fmt=*) '***********************************************************'
        write(unit=ncpoutcoli_cll,fmt=*) '                                                          '
      endif
    end if
    
    if(ncheckout_cll.ne.closed_cll) then
      inquire(ncheckout_cll, opened=qopened)
      if(qopened) then
        write(unit=ncheckout_cll,fmt=*) '                                                          '
        write(unit=ncheckout_cll,fmt=*) '***********************************************************'
        write(unit=ncheckout_cll,fmt=*) ' check precision set to checkacc =', checkacc_cll 
        write(unit=ncheckout_cll,fmt=*) '***********************************************************'
        write(unit=ncheckout_cll,fmt=*) '                                                          '
      end if
    end if
 
    if (infoutlev_cll.ge.1.and.critacc_cll.lt.reqacc_cll) then
      call infout_cll('SetAccuracy_cll','WARNING',infwri)     
      if(infwri) write(ninfout_cll,fmt33) '     critical precision critacc =', critacc_cll
      if(infwri) write(ninfout_cll,fmt45) '     smaller than required precision reqacc =', reqacc_cll
    end if
 
    if (infoutlev_cll.ge.1.and.checkacc_cll.lt.reqacc_cll) then
      call infout_cll('SetAccuracy_cll','WARNING',infwri)     
      if(infwri) write(ninfout_cll,fmt31) '     check precision checkacc =', checkacc_cll
      if(infwri) write(ninfout_cll,fmt45) '     smaller than required precision reqacc =', reqacc_cll
    end if
 
 
  end subroutine setaccuracy_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetReqAcc_cll(acc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setreqacc_cll(acc)
 
    double precision :: acc
    integer :: outlevel_dd,outchannel_dd,mode34_dd,mode5_dd,mode6_dd
    double precision :: cacc_dd,dacc_dd
    logical :: infwri
    character(len=*),parameter :: fmt12 = "(A12,Es17.10)"
    character(len=*),parameter :: fmt32 = "(A32,Es17.10)"
    character(len=*),parameter :: fmt43 = "(A43,Es17.10)"
    character(len=*),parameter :: fmt48 = "(A48,Es17.10)"
 
    reqacc_cll = acc
 
    call ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
    call ddsetmode(reqacc_cll,reqacc_cll,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
    call ddsetaccthr(reqacc_cll)
    call setreqacc_coli(acc)
 
    if (infoutlev_cll.ge.2) then
      infwri = .false.
      if (infoutlev_cll.ge.2) call infout_cll('SetReqAcc_cll','target precision set to',infwri)    
      if(infwri)  write(ninfout_cll,fmt12) '    reqacc =', reqacc_cll
    end if
 
    if (infoutlev_cll.ge.1.and.critacc_cll.lt.reqacc_cll) then
      call infout_cll('SetReqAcc_cll','WARNING',infwri)     
      if(infwri) write(ninfout_cll,fmt32) '     required precision reqacc =', reqacc_cll
      if(infwri) write(ninfout_cll,fmt48) '     larger than critical precision critacc =', critacc_cll
    end if
 
    if (infoutlev_cll.ge.1.and.checkacc_cll.lt.reqacc_cll) then
      call infout_cll('SetReqAcc_cll','WARNING',infwri)     
      if(infwri) write(ninfout_cll,fmt32) '     required precision reqacc =', reqacc_cll
      if(infwri) write(ninfout_cll,fmt43) '     larger than check precision checkacc =', checkacc_cll
    end if
 
  end subroutine setreqacc_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetReqAcc_cll(acc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getreqacc_cll(acc)
 
    double precision, intent(out) :: acc
 
    acc = reqacc_cll
 
  end subroutine getreqacc_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetCritAcc_cll(acc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setcritacc_cll(acc)
 
    double precision :: acc
    logical :: qopened,infwri
    character(len=*),parameter :: fmt93 = "(A13,Es17.10)"
    character(len=*),parameter :: fmt94 = "(A33,Es17.10)"
    character(len=*),parameter :: fmt95 = "(A45,Es17.10)"
    
    critacc_cll = acc
 
 
    call ddseterrthr(critacc_cll)
 
    call setcritacc_coli(acc)
 
    if(ncpoutcoli_cll.ne.closed_cll) then
      inquire(ncpoutcoli_cll, opened=qopened)
      if(qopened) then
        write(unit=ncpoutcoli_cll,fmt=*) '                                                          '
        write(unit=ncpoutcoli_cll,fmt=*) '***********************************************************'
        write(unit=ncpoutcoli_cll,fmt=*) ' critical precision set to critacc =', critacc_cll 
        write(unit=ncpoutcoli_cll,fmt=*) '***********************************************************'
        write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
      endif
    end if
    if(ncpout_cll.ne.closed_cll) then
      inquire(ncpout_cll, opened=qopened) 
      if(qopened) then
        write(unit=ncpout_cll,fmt=*) '                                                          '
        write(unit=ncpout_cll,fmt=*) '***********************************************************'
        write(unit=ncpout_cll,fmt=*) ' critical precision set to critacc =', critacc_cll 
        write(unit=ncpout_cll,fmt=*) '***********************************************************'
        write(unit=ncpout_cll,fmt=*) '                                                          ' 
      endif
    end if
    if(ncpout2_cll.ne.closed_cll) then
      inquire(ncpout2_cll, opened=qopened)
      if(qopened) then
        write(unit=ncpout2_cll,fmt=*) '                                                          '
        write(unit=ncpout2_cll,fmt=*) '***********************************************************'
        write(unit=ncpout2_cll,fmt=*) ' critical precision set to critacc =', critacc_cll 
        write(unit=ncpout2_cll,fmt=*) '***********************************************************'
        write(unit=ncpout2_cll,fmt=*) '                                                          ' 
      endif
    end if
    
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetCritAcc_cll','critical precision set to',infwri)    
    if(infwri)  write(ninfout_cll,fmt93) '    critacc =', critacc_cll
 
    if (infoutlev_cll.ge.1.and.critacc_cll.lt.reqacc_cll) then
      call infout_cll('SetCritAcc_cll','WARNING',infwri)     
      if(infwri) write(ninfout_cll,*) '     critical precision critacc =', critacc_cll
      if(infwri) write(ninfout_cll,*) '     smaller than required precision reqacc =', reqacc_cll
    end if
 
  end subroutine setcritacc_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetCritAcc_cll(acc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getcritacc_cll(acc)
 
    double precision, intent(out) :: acc
 
    acc = critacc_cll
 
  end subroutine getcritacc_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetCheckAcc(acc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setcheckacc_cll(acc)
 
    double precision :: acc
    logical :: qopened,infwri
    character(len=*),parameter :: fmt14 = "(A14,Es17.10)"
    character(len=*),parameter :: fmt30 = "(A31,Es17.10)"
    character(len=*),parameter :: fmt45 = "(A45,Es17.10)"
 
    checkacc_cll = acc
 
    if(ncheckout_cll.ne.closed_cll) then
      inquire(ncheckout_cll, opened=qopened)
      if (qopened) then
        write(unit=ncheckout_cll,fmt=*) '                                                          '
        write(unit=ncheckout_cll,fmt=*) '***********************************************************'
        write(unit=ncheckout_cll,fmt=*) ' check precision set to checkacc =', checkacc_cll 
        write(unit=ncheckout_cll,fmt=*) '***********************************************************'
        write(unit=ncheckout_cll,fmt=*) '                                                          '
      end if
    end if
        
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetCheckAcc_cll','check precision set to',infwri)    
    if(infwri)  write(ninfout_cll,fmt14) '    checkacc =', checkacc_cll
 
    if (infoutlev_cll.ge.1.and.checkacc_cll.lt.reqacc_cll) then
      call infout_cll('SetCheckAcc_cll','WARNING',infwri)     
      if(infwri) write(ninfout_cll,fmt30) '     check precision checkacc =', checkacc_cll
      if(infwri) write(ninfout_cll,fmt45) '     smaller than required precision reqacc =', reqacc_cll
    end if
 
 
  end subroutine setcheckacc_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetCheckAcc_cll(acc)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getcheckacc_cll(acc)
 
    double precision, intent(out) :: acc
 
    acc = checkacc_cll
 
  end subroutine getcheckacc_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetRitmax_cll(ritmax)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setritmax_cll(ritmax)
 
    double precision :: acc
    integer, intent(in) :: ritmax
    integer :: ritmaxB,ritmaxC,ritmaxD
    logical :: infwri
    character(len=*),parameter :: fmt12 = "(A12,i3)"
         
    infwri = .false.
    if (infoutlev_cll.ge.2) call infout_cll('SetRitmax_cll','maximum rank for expansions set to',infwri)    
    if(infwri)  write(ninfout_cll,fmt12) '    ritmax =', ritmax    
 
    if (ritmax.lt.max(7,rmax_cll+4-nmax_cll)) then
      ritmaxd = max(7,rmax_cll+4-nmax_cll)
      if (infoutlev_cll.ge.1) then
        if (rmax_cll+4-nmax_cll.gt.7) then
          call infout_cll('SetRitmax_cll','ritmax has to be at least rmax_cll + 4 - Nmax_cll'//  &
              ' --> it is set to rmax_cll + 4 - Nmax_cll',infwri)        
        else
          call infout_cll('SetRitmax_cll','ritmax has to be at least 7 --> it is set to 7',infwri)
        end if
      end if
    else
      ritmaxd = ritmax
    end if    
    
    ritmax_cll = ritmaxd
    ritmaxc = ritmaxd+2
    ritmaxb = ritmaxd+4
    call setncoefs(nmax_cll,ritmaxb)
    call setncoefsg(nmax_cll,ritmaxb)   
    
    call setritmaxbcd_cll(ritmaxb,ritmaxc,ritmaxd)
 
    call initglobaldd_cll(nmax_cll,ritmax_cll)
    call getreqacc_cll(acc)
    call setreqacc_cll(acc)
    call getcritacc_cll(acc)
    call setcritacc_cll(acc)
    
  end subroutine setritmax_cll
    
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetRitmaxBCD_cll(ritmax_B,ritmax_C,ritmax_D)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine setritmaxbcd_cll(ritmax_B,ritmax_C,ritmax_D)
 
    integer, intent(in) :: ritmax_B, ritmax_C, ritmax_D
    logical :: infwri
 
    if (ritmax_d.lt.4) then
      rmaxd_cll = 4    
      if (infoutlev_cll.ge.1) call infout_cll('SetRitmaxBCD_cll','ritmax_D has to be at least 4 --> it is set to 4',infwri)    
    else
      rmaxd_cll = ritmax_d
    end if
 
    if (ritmax_c.le.rmaxd_cll) then
      rmaxc_cll = rmaxd_cll+1
      if (infoutlev_cll.ge.1) call infout_cll('SetRitmaxBCD_cll', &
                                              'ritmax_C has to be larger than ritmax_C --> it is set to ritmax_D+1',infwri)        
    else
      rmaxc_cll = ritmax_c
    end if
 
    if (ritmax_b.le.rmaxc_cll) then
      rmaxb_cll = rmaxc_cll+1
      if (infoutlev_cll.ge.1) call infout_cll('SetRitmaxBCD_cll', &
                                              'ritmax_B has to be larger than ritmax_C --> it is set to ritmax_C+1',infwri)     
    else
      rmaxb_cll = ritmax_b
    end if
 
    ! set maximum rank in COLI
    call setritmax_coli(rmaxb_cll,rmaxc_cll,rmaxd_cll)
 
 
  end subroutine setritmaxbcd_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetRitmax_cll(ritmax)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  subroutine getritmax_cll(ritmax)
 
    integer, intent(out) :: ritmax
    
    ritmax = ritmax_cll
    
  end subroutine getritmax_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitErrFlag_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initerrflag_cll()
 
    call seterrflag_cll(0)
    call seterrflag_coli(0)
    call seterrflag_dd(0)
 
  end subroutine initerrflag_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetErrFlag_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine seterrflag_cll(val)
 
    integer, intent(in) :: val
 
    errflag_cll = val
!    call SetErrFlag_coli(val)
!    call SetErrFlag_dd(val)
 
  end subroutine seterrflag_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetErrFlag_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine geterrflag_cll(val)
 
    integer, intent(out) :: val
 
    val = errflag_cll
 
  end subroutine geterrflag_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine PropagateErrFlag_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine propagateerrflag_cll()
 
    integer :: efcoli,efdd,efcll,ef
 
 
  ! error flags in COLI
  !  -1 internal Check failed
  !  -4 argument on cut in log or dilog
  !  -5 crit event (error > critical error)    excluded!
  !  -5 wrong exit of rloop
  !  -6 no reduction method works for C or D
  !  -6 inconsistent input momenta (not 4-dimensional)
  !  -7 specific numerical problem
  !  -9 internal inconsistency (e.g. with cache or max. tensor rank)
  ! -10 case not supported/implemented
 
  ! default for ErrorStopFlag:  -8
 
 
  ! changed AD 31.07.2017
 
    call geterrflag_coli(efcoli)
    call geterrflag_dd(efdd)
    call geterrflag_cll(efcll)
    ef = min(efcoli,efdd,efcll)
 
  ! added AD 19.10.2017
    errflag_cll = ef
 
    if (ef.le.errorstop_cll) then
      if (efcoli.eq.ef) then
        write(stdout_cll,*) 'COLLIER: fatal error in COLI: ',efcoli
        write(stdout_cll,*) 'execution of program stopped'
        write(stdout_cll,*) 'error output written to the file ErrOut.coli'
      else if (efdd.eq.ef) then
        write(stdout_cll,*) 'COLLIER: fatal error in DD: ',efdd
        write(stdout_cll,*) 'execution of program stopped'
        write(stdout_cll,*) 'error output written to the file ErrOut.dd'
      else if (efcll.eq.ef) then
        write(stdout_cll,*) 'COLLIER: fatal error in COLLIER: ',efcll
        write(stdout_cll,*) 'execution of program stopped'
        write(stdout_cll,*) 'error output written to the file ErrOut.cll'
      end if
      stop
    end if
 
    if (monitoring) then
      errcnt(1)           = errcnt(1)           + 1
      errcntcoli(efcoli)  = errcntcoli(efcoli)  + 1
      errcntdd(efdd  )    = errcntdd(efdd)      + 1
      errcnt(ef)          = errcnt(ef) + 1
    end if
 
  end subroutine propagateerrflag_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxInfOut_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxinfout_cll(val)
 
    integer, intent(in) :: val
 
    maxinfout_cll = val
 
  end subroutine setmaxinfout_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxErrOut_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxerrout_cll(val)
 
    integer, intent(in) :: val
 
    maxerrout_cll = val
 
  end subroutine setmaxerrout_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitInfCnt_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initinfcnt_cll(val)
 
    integer, intent(in) :: val
 
    infcnt_cll = val
 
  end subroutine initinfcnt_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitErrCnt_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initerrcnt_cll(val)
 
    integer, intent(in) :: val
 
    errcnt_cll = val
 
  end subroutine initerrcnt_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitErrCntCOLI_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initerrcntcoli_cll()
 
!    integer, intent(in) :: val
    integer :: val    
 
    val = 0
    errcntcoli_cll = val
    call initerrcnt_coli(val)
 
  end subroutine initerrcntcoli_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxErrOutCOLI_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxerroutcoli_cll(val)
 
    integer, intent(in) :: val
 
    maxerroutcoli_cll = val
    call setmaxerrout_coli(val)
 
  end subroutine setmaxerroutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitErrCntDD_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initerrcntdd_cll()
 
!    integer, intent(in) :: val
 
!    ErrCntDD_cll = val
    errcntdd_cll = 0
    call ddresetcout()
 
  end subroutine initerrcntdd_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxErrOutDD_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxerroutdd_cll(val)
 
    integer, intent(in) :: val
 
    maxerroutdd_cll = val
    call ddsetcoutmax(val)
 
  end subroutine setmaxerroutdd_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitAccFlag_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initaccflag_cll()
 
    call setaccflag_cll(0)
 
  end subroutine initaccflag_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetAccFlag_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setaccflag_cll(val)
 
    integer, intent(in) :: val
 
    accflag_cll = val
 
  end subroutine setaccflag_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetAccFlag_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getaccflag_cll(val)
 
    integer, intent(out) :: val
 
    val = accflag_cll
 
  end subroutine getaccflag_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine PropagateAccFlag_cll(RelErrs,rmax)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine propagateaccflag_cll(RelErrs,rmax)
 
    integer, intent(in) :: rmax
    double precision, intent(in) :: RelErrs(0:rmax)
    integer :: loaf 
     
    loaf = 0
    if (maxval(relerrs).gt.reqacc_cll) loaf=-1
    if (maxval(relerrs).gt.critacc_cll) loaf=-2
    accflag_cll = min(accflag_cll,loaf)
 
    if (monitoring) then
      acccnt(1)    = acccnt(1)     + 1
      acccnt(loaf) = acccnt(loaf)  + 1
    end if
 
  end subroutine propagateaccflag_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetInfoutlev_coli(infoutlev)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setinfoutlevcoli_cll(infoutlev)
 
    integer, intent(in) :: infoutlev
 
    if(infoutlev.eq.0) then
       call unsetinfo_coli
    else
       call openinfoutfilecoli_cll(trim(foldername_cll)//'/InfOut.coli')
       call setinfo_coli
    endif
 
  end subroutine setinfoutlevcoli_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitCritPointsCntCOLI_cll(val)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initcritpointscntcoli_cll(val)
 
    integer, intent(in) :: val
 
    critpointscntcoli_cll = val
    call initcritpointscnt_coli(val)
 
  end subroutine initcritpointscntcoli_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitPointsCnt_cll(noreset)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initpointscnt_cll(noreset)
 
    logical, optional :: noreset
    integer :: Nold
    integer, allocatable :: saveCnt(:)
 
 
    if (present(noreset).and.noreset) then
      nold = size(checkcnt_cll)
      if (nold.lt.nmax_cll) then
        allocate(savecnt(nold))
 
        savecnt = pointscnttn_cll  
        deallocate(pointscnttn_cll)
        allocate(pointscnttn_cll(nmax_cll))      
        pointscnttn_cll(1:nold) = savecnt
        pointscnttn_cll(nold+1:nmax_cll) = 0
 
        savecnt = accpointscnttn_cll  
        deallocate(accpointscnttn_cll)
        allocate(accpointscnttn_cll(nmax_cll))      
        accpointscnttn_cll(1:nold) = savecnt
        accpointscnttn_cll(nold+1:nmax_cll) = 0
 
        savecnt = critpointscnttn_cll  
        deallocate(critpointscnttn_cll)
        allocate(critpointscnttn_cll(nmax_cll))      
        critpointscnttn_cll(1:nold) = savecnt
        critpointscnttn_cll(nold+1:nmax_cll) = 0
 
        savecnt = accpointscnttn2_cll  
        deallocate(accpointscnttn2_cll)
        allocate(accpointscnttn2_cll(nmax_cll))      
        accpointscnttn2_cll(1:nold) = savecnt
        accpointscnttn2_cll(nold+1:nmax_cll) = 0
 
        savecnt = critpointscnttn2_cll  
        deallocate(critpointscnttn2_cll)
        allocate(critpointscnttn2_cll(nmax_cll))      
        critpointscnttn2_cll(1:nold) = savecnt
        critpointscnttn2_cll(nold+1:nmax_cll) = 0
 
        savecnt = pointscnttn_coli  
        deallocate(pointscnttn_coli)
        allocate(pointscnttn_coli(nmax_cll))      
        pointscnttn_coli(1:nold) = savecnt
        pointscnttn_coli(nold+1:nmax_cll) = 0
 
        savecnt = pointscnttn_dd  
        deallocate(pointscnttn_dd)
        allocate(pointscnttn_dd(nmax_cll))      
        pointscnttn_dd(1:nold) = savecnt
        pointscnttn_dd(nold+1:nmax_cll) = 0
 
        savecnt = pointscnttnten_cll  
        deallocate(pointscnttnten_cll)
        allocate(pointscnttnten_cll(nmax_cll))      
        pointscnttnten_cll(1:nold) = savecnt
        pointscnttnten_cll(nold+1:nmax_cll) = 0
 
        savecnt = accpointscnttnten_cll  
        deallocate(accpointscnttnten_cll)
        allocate(accpointscnttn_cll(nmax_cll))      
        accpointscnttn_cll(1:nold) = savecnt
        accpointscnttn_cll(nold+1:nmax_cll) = 0
 
        savecnt = critpointscnttnten_cll  
        deallocate(critpointscnttnten_cll)
        allocate(critpointscnttnten_cll(nmax_cll))      
        critpointscnttnten_cll(1:nold) = savecnt
        critpointscnttnten_cll(nold+1:nmax_cll) = 0
 
        savecnt = pointscnttnten_coli  
        deallocate(pointscnttnten_coli)
        allocate(pointscnttnten_coli(nmax_cll))      
        pointscnttnten_coli(1:nold) = savecnt
        pointscnttnten_coli(nold+1:nmax_cll) = 0
 
        savecnt = pointscnttnten_dd  
        deallocate(pointscnttnten_dd)
        allocate(pointscnttnten_dd(nmax_cll))      
        pointscnttnten_dd(1:nold) = savecnt
        pointscnttnten_dd(nold+1:nmax_cll) = 0
        
      end if
    
    else
      if(allocated(pointscnttn_cll)) deallocate(pointscnttn_cll)
      if(allocated(accpointscnttn_cll)) deallocate(accpointscnttn_cll)
      if(allocated(critpointscnttn_cll)) deallocate(critpointscnttn_cll)
      if(allocated(accpointscnttn2_cll)) deallocate(accpointscnttn2_cll)
      if(allocated(critpointscnttn2_cll)) deallocate(critpointscnttn2_cll)
      if(allocated(pointscnttn_coli)) deallocate(pointscnttn_coli)
      if(allocated(pointscnttn_dd)) deallocate(pointscnttn_dd)
      if(allocated(pointscnttnten_cll)) deallocate(pointscnttnten_cll)
      if(allocated(accpointscnttnten_cll)) deallocate(accpointscnttnten_cll)
      if(allocated(critpointscnttnten_cll)) deallocate(critpointscnttnten_cll)
      if(allocated(pointscnttnten_coli)) deallocate(pointscnttnten_coli)
      if(allocated(pointscnttnten_dd)) deallocate(pointscnttnten_dd)
 
      ! re-allocate Counters for Critical Points
      allocate(pointscnttn_cll(nmax_cll))
      allocate(accpointscnttn_cll(nmax_cll))
      allocate(critpointscnttn_cll(nmax_cll))
      allocate(accpointscnttn2_cll(nmax_cll))
      allocate(critpointscnttn2_cll(nmax_cll))
      allocate(pointscnttn_coli(nmax_cll))
      allocate(pointscnttn_dd(nmax_cll))
      allocate(pointscnttnten_cll(nmax_cll))
      allocate(accpointscnttnten_cll(nmax_cll))
      allocate(critpointscnttnten_cll(nmax_cll))
      allocate(pointscnttnten_coli(nmax_cll))
      allocate(pointscnttnten_dd(nmax_cll))
 
      pointscnta_cll = 0
      pointscntb_cll = 0
      pointscntc_cll = 0
      pointscntd_cll = 0
      pointscnte_cll = 0
      pointscntf_cll = 0
      pointscntg_cll = 0
      pointscnttn_cll = 0
      pointscntdb_cll = 0
      accpointscnta_cll = 0
      accpointscntb_cll = 0
      accpointscntc_cll = 0
      accpointscntd_cll = 0
      accpointscnte_cll = 0
      accpointscntf_cll = 0
      accpointscntg_cll = 0
      accpointscnttn_cll = 0
      accpointscntdb_cll = 0
      critpointscnta_cll = 0
      critpointscntb_cll = 0
      critpointscntc_cll = 0
      critpointscntd_cll = 0
      critpointscnte_cll = 0
      critpointscntf_cll = 0
      critpointscntg_cll = 0
      critpointscnttn_cll = 0
      critpointscntdb_cll = 0
 
      accpointscnta2_cll = 0
      accpointscntb2_cll = 0
      accpointscntc2_cll = 0
      accpointscntd2_cll = 0
      accpointscnte2_cll = 0
      accpointscntf2_cll = 0
      accpointscntg2_cll = 0
      accpointscnttn2_cll = 0
      accpointscntdb2_cll = 0
      critpointscnta2_cll = 0
      critpointscntb2_cll = 0
      critpointscntc2_cll = 0
      critpointscntd2_cll = 0
      critpointscnte2_cll = 0
      critpointscntf2_cll = 0
      critpointscntg2_cll = 0
      critpointscnttn2_cll = 0
      critpointscntdb2_cll = 0
 
      pointscnta_coli = 0
      pointscntb_coli = 0
      pointscntc_coli = 0
      pointscntd_coli = 0
      pointscnte_coli = 0
      pointscntf_coli = 0
      pointscntg_coli = 0
      pointscnttn_coli = 0
      pointscntdb_coli = 0
 
      pointscnta_dd = 0
      pointscntb_dd = 0
      pointscntc_dd = 0
      pointscntd_dd = 0
      pointscnte_dd = 0
      pointscntf_dd = 0
      pointscntg_dd = 0
      pointscnttn_dd = 0
      pointscntdb_dd = 0
 
      pointscntaten_cll = 0
      pointscntbten_cll = 0
      pointscntcten_cll = 0
      pointscntdten_cll = 0
      pointscnteten_cll = 0
      pointscntften_cll = 0
      pointscntgten_cll = 0
      pointscnttnten_cll = 0
      pointscntdbten_cll = 0
      accpointscntaten_cll = 0
      accpointscntbten_cll = 0
      accpointscntcten_cll = 0
      accpointscntdten_cll = 0
      accpointscnteten_cll = 0
      accpointscntften_cll = 0
      accpointscntgten_cll = 0
      accpointscnttnten_cll = 0
      accpointscntdbten_cll = 0
      critpointscntaten_cll = 0
      critpointscntbten_cll = 0
      critpointscntcten_cll = 0
      critpointscntdten_cll = 0
      critpointscnteten_cll = 0
      critpointscntften_cll = 0
      critpointscntgten_cll = 0
      critpointscnttnten_cll = 0
      critpointscntdbten_cll = 0
 
 
      pointscntaten_coli = 0
      pointscntbten_coli = 0
      pointscntcten_coli = 0
      pointscntdten_coli = 0
      pointscnteten_coli = 0
      pointscntften_coli = 0
      pointscntgten_coli = 0
      pointscnttnten_coli = 0
      pointscntdbten_coli = 0
 
      pointscntaten_dd = 0
      pointscntbten_dd = 0
      pointscntcten_dd = 0
      pointscntdten_dd = 0
      pointscnteten_dd = 0
      pointscntften_dd = 0
      pointscntgten_dd = 0
      pointscnttnten_dd = 0
      pointscntdbten_dd = 0
 
      errcntcoli = 0
      errcntdd = 0
      errcnt = 0
      acccnt = 0
      erreventcnt = 0
      acceventcnt = 0
      
    end if
    
  end subroutine initpointscnt_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitMonitoring_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initmonitoring_cll()
  
    logical :: infwri
 
! changed 29.02.2016 AD
!    if (Monitoring) then
!      if (infoutlev_cll.ge.2) call InfOut_cll('InitMonitoring_cll','CritPointsMonitor already initialized',infwri)   
!      return
!    endif
    
    if (monitoring) then
      if (infoutlev_cll.ge.2) call infout_cll('InitMonitoring_cll','CritPointsMonitor re-initialized',infwri)   
    else
      if (infoutlev_cll.ge.2) call infout_cll('InitMonitoring_cll','CritPointsMonitor initialized',infwri) 
    endif
 
    monitoring = .true. 
 
    call initpointscnt_cll()
    call initmaxcritpoints_cll
    call initmaxcritpointsdb_cll
    call opencritpointsoutfile_cll(trim(foldername_cll)//'/CritPointsOut.cll')
 
#ifdef CritPoints2
    call opencritpointsoutfile2_cll(trim(foldername_cll)//'/CritPointsOut2.cll')
#endif
 
#ifdef CritPointsCOLI 
    call initcritpointscntcoli_cll(0)
    call opencritpointsoutfilecoli_cll(trim(foldername_cll)//'/CritPointsOut.coli')
#endif
 
  end subroutine initmonitoring_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitOutChan_cll(init_stdout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initoutchan_cll(init_stdout)
 
    logical, optional :: init_stdout
    integer :: outlevel_dd,outchannel_dd,mode34_dd,mode5_dd,mode6_dd
    double precision :: cacc_dd,dacc_dd
    logical :: stdflag
  
    if(present(init_stdout)) then
      stdflag=init_stdout
    else
      stdflag=.true.
    end if
    
    if(stdflag.or.(nerrout_cll.ne.stdout_cll)) then
      nerrout_cll = closed_cll
      fname_errout_cll = ''
    end if
 
    if(stdflag.or.(nerroutcoli_cll.ne.stdout_cll)) then    
      nerroutcoli_cll = closed_cll
      call setnerrout_coli(nerroutcoli_cll)    
      fname_erroutcoli_cll = ''
    end if
      
    if(stdflag.or.(nerroutdd_cll.ne.stdout_cll)) then     
      nerroutdd_cll = closed_cll
      call  ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
      call  ddsetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,nerroutdd_cll)
      call  ddsetcout_on(.false.)
      fname_erroutdd_cll = ''
    end if
 
    if(stdflag.or.(ninfout_cll.ne.stdout_cll)) then   
      ninfout_cll = closed_cll
      fname_infout_cll = ''
    end if
    
    if(stdflag.or.(ninfoutcoli_cll.ne.stdout_cll)) then
      ninfoutcoli_cll = closed_cll
      call setninfout_coli(ninfoutcoli_cll)    
      fname_infoutcoli_cll = ''
    end if
    
    if(stdflag.or.(ncheckout_cll.ne.stdout_cll)) then
      ncheckout_cll = closed_cll
      fname_checkout_cll = ''
    end if
 
    if(stdflag.or.(ncpoutcoli_cll.ne.stdout_cll)) then
      ncpoutcoli_cll = closed_cll
      call setncpout_coli(ncpoutcoli_cll)
      fname_cpoutcoli_cll = ''
    end if
    
    if(stdflag.or.(ncpout_cll.ne.stdout_cll)) then
      ncpout_cll = closed_cll
      fname_cpout_cll = ''
    end if
    
    if(stdflag.or.(ncpout2_cll.ne.stdout_cll)) then
      ncpout2_cll = closed_cll
      fname_cpout2_cll = ''
    end if
    
    if(stdflag.or.(nstatsoutcoli_cll.ne.stdout_cll)) then
      nstatsoutcoli_cll = closed_cll
      call setnstatsout_coli(nstatsoutcoli_cll)    
      fname_statsoutcoli_cll = ''
    end if
        
!    qopened_critcoli = .false.
!    qopened_crit = .false.
!    qopened_crit2 = .false.
!    qopened_check = .false.
!    qopened_statscoli = .false.
 
 
  end subroutine initoutchan_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitOutChan_cp_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initoutchan_cp_cll
    
    nerrout_cp_cll = closed_cll
    fname_errout_cp_cll = ''   
    nerroutcoli_cp_cll = closed_cll    
    fname_erroutcoli_cp_cll = ''    
    nerroutdd_cp_cll = closed_cll
    fname_erroutdd_cp_cll = '' 
    ninfout_cp_cll = closed_cll
    fname_infout_cp_cll = ''
    ninfoutcoli_cp_cll = closed_cll    
    fname_infoutcoli_cp_cll = ''
    ncheckout_cp_cll = closed_cll
    fname_checkout_cp_cll = ''
    ncpoutcoli_cp_cll = closed_cll
    fname_cpoutcoli_cp_cll = ''
    ncpout_cp_cll = closed_cll
    fname_cpout_cp_cll = ''
    ncpout2_cp_cll = closed_cll
    fname_cpout2_cp_cll = ''
    nstatsoutcoli_cp_cll = closed_cll  
    fname_statsoutcoli_cp_cll = ''
 
  end subroutine initoutchan_cp_cll
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setninfout_cll(ninfout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setninfout_cll(ninfout)
 
    integer, intent(in), optional :: ninfout
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(ninfout_cll.ne.closed_cll) then
      inquire(ninfout_cll, opened=qopened)
      if(qopened.and.(ninfout_cll.ne.stdout_cll)) close(unit=ninfout_cll)
    end if
    
    if (present(ninfout)) then
      if (len(trim(fname_infout_cll)).eq.0) then
        call openinfoutfile_cll(trim(foldername_cll)//'/InfOut.cll',ninfout)
      else if (ninfout.ne.stdout_cll) then
        inquire(ninfout, opened=qopened)
        if(qopened) close(unit=ninfout)
        ninfout_cll = ninfout
        call setninfout_cache(ninfout_cll)        
        open(unit=ninfout_cll,file=trim(fname_infout_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_infout_cll)).eq.0) then
        call openinfoutfile_cll(trim(foldername_cll)//'/InfOut.cll')
      else
        ninfout_cll = findfreechannel_cll()
        call setninfout_cache(ninfout_cll)        
        open(unit=ninfout_cll,file=trim(fname_infout_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    end if
 
  end subroutine setninfout_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Getninfout_cll(ninfout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getninfout_cll(ninfout)
 
    integer, intent(out) :: ninfout
 
    ninfout = ninfout_cll
 
  end subroutine getninfout_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setninfoutcoli_cll(ninfout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setninfoutcoli_cll(ninfout)
 
    integer, intent(in), optional :: ninfout
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(ninfoutcoli_cll.ne.closed_cll) then
      inquire(ninfoutcoli_cll, opened=qopened)
      if(qopened.and.(ninfoutcoli_cll.ne.stdout_cll)) close(unit=ninfoutcoli_cll)
    end if
    
    if (present(ninfout)) then
      if (len(trim(fname_infoutcoli_cll)).eq.0) then
        call openinfoutfilecoli_cll(trim(foldername_cll)//'/InfOut.coli',ninfout)
      else if (ninfout.ne.stdout_cll) then
        inquire(ninfout, opened=qopened)
        if(qopened) close(unit=ninfout)
        ninfoutcoli_cll = ninfout
        call setninfout_coli(ninfoutcoli_cll)          
        open(unit=ninfoutcoli_cll,file=trim(fname_infoutcoli_cll),form='formatted',access='sequential', &
                                  position='append',status='old')
      end if
    else
      if (len(trim(fname_infoutcoli_cll)).eq.0) then
        call openinfoutfilecoli_cll(trim(foldername_cll)//'/InfOut.coli')
      else
        ninfoutcoli_cll = findfreechannel_cll()
        call setninfout_coli(ninfoutcoli_cll)       
        open(unit=ninfoutcoli_cll,file=trim(fname_infoutcoli_cll),form='formatted',access='sequential', &
                                  position='append',status='old')       
      end if
    end if
 
  end subroutine setninfoutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetninfoutCOLI_cll(ninfout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getninfoutcoli_cll(ninfout)
 
    integer, intent(out) :: ninfout
 
    ninfout = ninfoutcoli_cll
 
  end subroutine getninfoutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setnerrout_cll(nerrout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setnerrout_cll(nerrout)
 
    integer, intent(in), optional :: nerrout
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(nerrout_cll.ne.closed_cll) then
      inquire(nerrout_cll, opened=qopened)
      if(qopened.and.(nerrout_cll.ne.stdout_cll)) close(unit=nerrout_cll)
    end if
    
    if (present(nerrout)) then
      if (len(trim(fname_errout_cll)).eq.0) then
        call openerroutfile_cll(trim(foldername_cll)//'/ErrOut.cll',nerrout)
      else if (nerrout.ne.stdout_cll) then
        inquire(nerrout, opened=qopened)
        if(qopened) close(unit=nerrout)
        nerrout_cll = nerrout        
        open(unit=nerrout_cll,file=trim(fname_errout_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_errout_cll)).eq.0) then
        call openerroutfile_cll(trim(foldername_cll)//'/ErrOut.cll')
      else
        nerrout_cll = findfreechannel_cll()
        open(unit=nerrout_cll,file=trim(fname_errout_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    end if
      
 
  end subroutine setnerrout_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Getnerrout_cll(nerrout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getnerrout_cll(nerrout)
 
    integer, intent(out) :: nerrout
 
    nerrout = nerrout_cll
 
  end subroutine getnerrout_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetnerroutCOLI_cll(nerrout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setnerroutcoli_cll(nerrout)
 
    integer, intent(in), optional :: nerrout
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(nerroutcoli_cll.ne.closed_cll) then
      inquire(nerroutcoli_cll, opened=qopened)
      if(qopened.and.(nerroutcoli_cll.ne.stdout_cll)) close(unit=nerroutcoli_cll)
    end if
    
    if (present(nerrout)) then
      if (len(trim(fname_erroutcoli_cll)).eq.0) then
        call openerroutfilecoli_cll(trim(foldername_cll)//'/ErrOut.coli',nerrout)
      else if (nerrout.ne.stdout_cll) then
        inquire(nerrout, opened=qopened)
        if(qopened) close(unit=nerrout)
        nerroutcoli_cll = nerrout 
        call setnerrout_coli(nerroutcoli_cll)        
        open(unit=nerroutcoli_cll,file=trim(fname_erroutcoli_cll),form='formatted', &
                                  access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_erroutcoli_cll)).eq.0) then
        call openerroutfilecoli_cll(trim(foldername_cll)//'/ErrOut.cll')
      else
        nerroutcoli_cll = findfreechannel_cll()
        call setnerrout_coli(nerroutcoli_cll)       
        open(unit=nerroutcoli_cll,file=trim(fname_erroutcoli_cll),form='formatted', &
                                  access='sequential',position='append',status='old')       
      end if
    end if
 
  end subroutine setnerroutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetnerroutCOLI_cll(nerrout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getnerroutcoli_cll(nerrout)
 
    integer, intent(out) :: nerrout
 
    nerrout = nerroutcoli_cll
 
  end subroutine getnerroutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetnerroutDD_cll(nerrout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setnerroutdd_cll(nerrout)
 
    integer, intent(in), optional :: nerrout
    integer :: outlevel_dd,outchannel_dd,mode34_dd,mode5_dd,mode6_dd
    double precision :: cacc_dd,dacc_dd
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(nerroutdd_cll.ne.closed_cll) then
      inquire(nerroutdd_cll, opened=qopened)
      if(qopened.and.(nerroutdd_cll.ne.stdout_cll)) close(unit=nerroutdd_cll)
    end if
    
    if (present(nerrout)) then
      if (len(trim(fname_erroutdd_cll)).eq.0) then
        call openerroutfiledd_cll(trim(foldername_cll)//'/ErrOut.dd',nerrout)
      else if (nerrout.ne.stdout_cll) then
        inquire(nerrout, opened=qopened)
        if(qopened) close(unit=nerrout)
        nerroutdd_cll = nerrout
        call  ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
        call  ddsetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,nerroutdd_cll)
        if (erroutlev_cll.gt.0) then
          call  ddsetcout_on(.true.)
        end if
        open(unit=nerroutdd_cll,file=trim(fname_erroutdd_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_erroutdd_cll)).eq.0) then
        call openerroutfiledd_cll(trim(foldername_cll)//'/ErrOut.dd')
      else
        nerroutdd_cll = findfreechannel_cll()
        call  ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
        call  ddsetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,nerroutdd_cll)
        if (erroutlev_cll.gt.0) then
          call  ddsetcout_on(.true.)
        end if
        open(unit=nerroutdd_cll,file=trim(fname_erroutdd_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    end if    
      
  end subroutine setnerroutdd_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetnerroutDD_cll(nerrout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getnerroutdd_cll(nerrout)
 
    integer, intent(out) :: nerrout
 
    nerrout = nerroutdd_cll
 
  end subroutine getnerroutdd_cll
 
  
  
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setncheckout_cll(ncheckout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setncheckout_cll(ncheckout)
 
    integer, intent(in), optional :: ncheckout
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(ncheckout_cll.ne.closed_cll) then
      inquire(ncheckout_cll, opened=qopened)
      if(qopened.and.(ncheckout_cll.ne.stdout_cll)) close(unit=ncheckout_cll)
    end if
    
    if (present(ncheckout)) then
      if (len(trim(fname_checkout_cll)).eq.0) then
        call opencheckoutfile_cll(trim(foldername_cll)//'/CheckOut.cll',ncheckout)
      else if (ncheckout.ne.stdout_cll) then
        inquire(ncheckout, opened=qopened)
        if(qopened) close(unit=ncheckout)
        ncheckout_cll = ncheckout        
        open(unit=ncheckout_cll,file=trim(fname_checkout_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_checkout_cll)).eq.0) then
        call opencheckoutfile_cll(trim(foldername_cll)//'/CheckOut.cll')
      else
        ncheckout_cll = findfreechannel_cll()
        open(unit=ncheckout_cll,file=trim(fname_checkout_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    end if
    
 
  end subroutine setncheckout_cll
 
  
  
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Getncheckout_cll(ncheckout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getncheckout_cll(ncheckout)
 
    integer, intent(out) :: ncheckout
 
    ncheckout = ncheckout_cll
 
  end subroutine getncheckout_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setncpoutcoli_cll(ncpout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setncpoutcoli_cll(ncpout)
 
    integer, intent(in), optional :: ncpout
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(ncpoutcoli_cll.ne.closed_cll) then
      inquire(ncpoutcoli_cll, opened=qopened)
      if(qopened.and.(ncpoutcoli_cll.ne.stdout_cll)) close(unit=ncpoutcoli_cll)
    end if
    
    if (present(ncpout)) then
      if (len(trim(fname_cpoutcoli_cll)).eq.0) then
        call opencritpointsoutfilecoli_cll(trim(foldername_cll)//'/CritPointsOut.coli',ncpout)
      else if (ncpout.ne.stdout_cll) then
        inquire(ncpout, opened=qopened)
        if(qopened) close(unit=ncpout)
        ncpoutcoli_cll = ncpout
        call setncpout_coli(ncpoutcoli_cll)
        open(unit=ncpoutcoli_cll,file=trim(fname_cpoutcoli_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_cpoutcoli_cll)).eq.0) then
        call opencritpointsoutfilecoli_cll(trim(foldername_cll)//'/CritPointsOut.coli')
      else
        ncpoutcoli_cll = findfreechannel_cll()
        call setncpout_coli(ncpoutcoli_cll)
        open(unit=ncpoutcoli_cll,file=trim(fname_cpoutcoli_cll),form='formatted',access='sequential',position='append',status='old')       
      end if
    end if
 
  end subroutine setncpoutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetncpoutCOLI_cll(ncpout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getncpoutcoli_cll(ncpout)
 
    integer, intent(out) :: ncpout
 
    ncpout = ncpoutcoli_cll
 
  end subroutine getncpoutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setnstatsoutcoli_cll(nstatsout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setnstatsoutcoli_cll(nstatsout)
 
    integer, intent(in), optional :: nstatsout
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(nstatsoutcoli_cll.ne.closed_cll) then
      inquire(nstatsoutcoli_cll, opened=qopened)
      if(qopened.and.(nstatsoutcoli_cll.ne.stdout_cll)) close(unit=nstatsoutcoli_cll)
    end if
    
    if (present(nstatsout)) then
      if (len(trim(fname_statsoutcoli_cll)).eq.0) then
        call openstatisticsoutfilecoli_cll(trim(foldername_cll)//'/StatisticsOut.coli',nstatsout)
      else if (nstatsout.ne.stdout_cll) then
        inquire(nstatsout, opened=qopened)
        if(qopened) close(unit=nstatsout)
        nstatsoutcoli_cll = nstatsout
        call setnstatsout_coli(nstatsoutcoli_cll)
        open(unit=nstatsoutcoli_cll,file=trim(fname_statsoutcoli_cll),form='formatted',access='sequential', &
                                    position='append',status='old')
      end if
    else
      if (len(trim(fname_statsoutcoli_cll)).eq.0) then
        call openstatisticsoutfilecoli_cll(trim(foldername_cll)//'/StatisticsOut.coli')
      else
        nstatsoutcoli_cll = findfreechannel_cll()
        call setnstatsout_coli(nstatsoutcoli_cll)
        open(unit=nstatsoutcoli_cll,file=trim(fname_statsoutcoli_cll),form='formatted',access='sequential', &
                                    position='append',status='old')       
      end if
    end if
 
  end subroutine setnstatsoutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetstatsoutCOLI_cll(nstatsout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getnstatsoutcoli_cll(nstatsout)
 
    integer, intent(out) :: nstatsout
 
    nstatsout = nstatsoutcoli_cll
 
  end subroutine getnstatsoutcoli_cll
 
  
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setncritpointsout_cll(ncpout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setncritpointsout_cll(ncpout)
 
    integer, intent(in), optional :: ncpout
    logical :: qopened
     
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(ncpout_cll.ne.closed_cll) then
      inquire(ncpout_cll, opened=qopened)
      if(qopened.and.(ncpout_cll.ne.stdout_cll)) close(unit=ncpout_cll)
    end if
    
    if (present(ncpout)) then
      if (len(trim(fname_cpout_cll)).eq.0) then
        call opencritpointsoutfile_cll(trim(foldername_cll)//'/CritPointsOut.cll',ncpout)
      else if (ncpout.ne.stdout_cll) then
        inquire(ncpout, opened=qopened)
        if(qopened) close(unit=ncpout)
        ncpout_cll = ncpout
        open(unit=ncpout_cll,file=trim(fname_cpout_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_cpout_cll)).eq.0) then
        call opencritpointsoutfile_cll(trim(foldername_cll)//'/CritPointsOut.cll')
      else
        ncpout_cll = findfreechannel_cll()
        open(unit=ncpout_cll,file=trim(fname_cpout_cll),form='formatted',access='sequential',position='append',status='old')       
      end if
    end if
 
  end subroutine setncritpointsout_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Getncritpointsout_cll(ncritpointsout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getncritpointsout_cll(ncritpointsout)
 
    integer, intent(out) :: ncritpointsout
 
    ncritpointsout = ncpout_cll
 
  end subroutine getncritpointsout_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Setncritpointsout_cll(ncpout)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setncritpointsout2_cll(ncpout)
 
    integer, intent(in), optional :: ncpout
    logical :: qopened
     
    ! return if output into files is suppressed
    if (nofiles_cll) return
 
    if(ncpout2_cll.ne.closed_cll) then
      inquire(ncpout2_cll, opened=qopened)
      if(qopened.and.(ncpout2_cll.ne.stdout_cll)) close(unit=ncpout2_cll)
    end if
    
    if (present(ncpout)) then
      if (len(trim(fname_cpout2_cll)).eq.0) then
        call opencritpointsoutfile2_cll(trim(foldername_cll)//'/CritPointsOut2.cll',ncpout)
      else if (ncpout.ne.stdout_cll) then
        inquire(ncpout, opened=qopened)
        if(qopened) close(unit=ncpout)
        ncpout2_cll = ncpout
        open(unit=ncpout2_cll,file=trim(fname_cpout2_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    else
      if (len(trim(fname_cpout2_cll)).eq.0) then
        call opencritpointsoutfile2_cll(trim(foldername_cll)//'/CritPointsOut2.cll')
      else
        ncpout2_cll = findfreechannel_cll()
        open(unit=ncpout2_cll,file=trim(fname_cpout2_cll),form='formatted',access='sequential',position='append',status='old')
      end if
    end if    
 
  end subroutine setncritpointsout2_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetOutputFolder_cll(fname)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setoutputfolder_cll(fname)
 
    character(len=*), intent(in) :: fname  
 
    foldername_cll = fname
    fname_errout_cll = ''       
    fname_erroutcoli_cll = ''
    fname_erroutdd_cll = ''
    fname_infout_cll = ''
    fname_infoutcoli_cll = ''
    fname_checkout_cll = ''
    fname_cpoutcoli_cll = ''
    fname_cpout_cll = ''
    fname_cpout2_cll = ''    
    fname_statsoutcoli_cll = '' 
    
    call execute_command_line('mkdir -p '//trim(foldername_cll))   
    
    call switchofffileoutput_cll
    call switchonfileoutput_cll    
    
  end subroutine setoutputfolder_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetOutputFolder_cll(fname)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getoutputfolder_cll(fname)
 
    character(len=*), intent(out) :: fname  
 
    fname = foldername_cll
    
  end subroutine getoutputfolder_cll
 
  
  
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine Getncritpointsout_cll(ncritpointsout2)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getncritpointsout2_cll(ncritpointsout2)
 
    integer, intent(out) :: ncritpointsout2
 
    ncritpointsout2 = ncpout2_cll
 
  end subroutine getncritpointsout2_cll
 
 
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine GetOutChannels_cll(chans)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine getoutchannels_cll(chans)
 
    integer, intent(out) :: chans(10)
 
    call getninfout_cll(chans(1))
    call getninfoutcoli_cll(chans(2))
    call getnerrout_cll(chans(3))
    call getnerroutcoli_cll(chans(4))
    call getnerroutdd_cll(chans(5))
    call getncheckout_cll(chans(6))
    call getncritpointsout_cll(chans(7))
    call getncritpointsout2_cll(chans(8))
    call getncpoutcoli_cll(chans(9))
    call getnstatsoutcoli_cll(chans(10))
    
 
  end subroutine getoutchannels_cll
 
  
  
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitCheckCntDB_cll()
  !i
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initcheckcntdb_cll
 
    checkcntdb_cll = 0
    diffcntdb_cll = 0
 
  end subroutine initcheckcntdb_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitMaxCheckDB_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initmaxcheckdb_cll
 
    maxcheckdb_cll = 50
 
  end subroutine initmaxcheckdb_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxCheckDB_cll(npoints)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxcheckdb_cll(npoints)
 
    integer, intent(in) :: npoints
 
    maxcheckdb_cll = npoints
 
  end subroutine setmaxcheckdb_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitCheckCnt_cll(noreset)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initcheckcnt_cll(noreset)
    logical, optional :: noreset
    integer :: Nold
    integer, allocatable :: saveCnt(:)
 
 
    if (present(noreset).and.noreset) then
      nold = size(checkcnt_cll)
      if (nold.lt.nmax_cll) then
        allocate(savecnt(nold))
 
        savecnt = checkcnt_cll  
        deallocate(checkcnt_cll)
        allocate(checkcnt_cll(nmax_cll))      
        checkcnt_cll(1:nold) = savecnt
        checkcnt_cll(nold+1:nmax_cll) = 0
 
        savecnt = diffcnt_cll
        deallocate(diffcnt_cll)
        allocate(diffcnt_cll(nmax_cll))
        diffcnt_cll(1:nold) = savecnt
        diffcnt_cll(nold+1:nmax_cll) = 0
 
        savecnt = checkcntten_cll
        deallocate(checkcntten_cll)
        allocate(checkcntten_cll(nmax_cll))
        checkcntten_cll(1:nold) = savecnt
        checkcntten_cll(nold+1:nmax_cll) = 0
 
        savecnt = diffcntten_cll
        deallocate(diffcntten_cll)
        allocate(diffcntten_cll(nmax_cll))
        diffcntten_cll(1:nold) = savecnt
        diffcntten_cll(nold+1:nmax_cll) = 0
      end if
    else
      if (allocated(checkcnt_cll)) deallocate(checkcnt_cll)
      allocate(checkcnt_cll(nmax_cll))
      checkcnt_cll = 0
      if (allocated(diffcnt_cll)) deallocate(diffcnt_cll)
      allocate(diffcnt_cll(nmax_cll))
      diffcnt_cll = 0
      diffcntec_cll = 0
      if (allocated(checkcntten_cll)) deallocate(checkcntten_cll)
      allocate(checkcntten_cll(nmax_cll))
      checkcntten_cll = 0
      if (allocated(diffcntten_cll)) deallocate(diffcntten_cll)
      allocate(diffcntten_cll(nmax_cll))
      diffcntten_cll = 0
    endif
 
  end subroutine initcheckcnt_cll
 
  
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitMaxCheck_cll(noreset)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initmaxcheck_cll(noreset)
    logical, optional :: noreset
    integer :: Nold
    integer, allocatable :: saveMax(:)
 
    if (present(noreset).and.noreset) then
      nold = size(maxcheck_cll)
      if (nold.lt.nmax_cll) then
        allocate(savemax(nold))
 
        savemax = maxcheck_cll  
        deallocate(maxcheck_cll)
        allocate(maxcheck_cll(nmax_cll))      
        maxcheck_cll(1:nold) = savemax
        maxcheck_cll(nold+1:nmax_cll) = 50
      end if
      
    else  
      if (allocated(maxcheck_cll)) deallocate(maxcheck_cll)
      allocate(maxcheck_cll(nmax_cll))
      maxcheck_cll = 50
    end if
    
    maxcheckec_cll = 50
 
  end subroutine initmaxcheck_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxCheckN_cll(npoints,N)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxcheckn_cll(npoints,N)
 
    integer, intent(in) :: npoints,N
 
    maxcheck_cll(n) = npoints
 
  end subroutine setmaxcheckn_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxCheckArray_cll(npoints)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxcheckarray_cll(npoints)
 
    integer, intent(in) :: npoints(Nmax_cll)
 
    maxcheck_cll = npoints
 
  end subroutine setmaxcheckarray_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitMaxCritPointsDB_cll()
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initmaxcritpointsdb_cll
 
    noutcritpointsmaxdb_cll = 50
 
  end subroutine initmaxcritpointsdb_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxCritPointsDB_cll(npoints)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxcritpointsdb_cll(npoints)
 
    integer, intent(in) :: npoints
 
    noutcritpointsmaxdb_cll = npoints
 
  end subroutine setmaxcritpointsdb_cll
  
  
 
  
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InitMaxCritPoints_cll(noreset)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine initmaxcritpoints_cll(noreset)
 
    logical, optional :: noreset
    integer :: Nold
    integer, allocatable :: saveMax(:)
 
    if (present(noreset).and.noreset) then
      nold = size(noutcritpointsmax_cll)
      if (nold.lt.nmax_cll) then
        allocate(savemax(nold))
        savemax = noutcritpointsmax_cll 
        deallocate(noutcritpointsmax_cll)
        allocate(noutcritpointsmax_cll(nmax_cll))      
        noutcritpointsmax_cll(1:nold) = savemax
        noutcritpointsmax_cll(nold+1:nmax_cll) = 50
      end if
      
    else
      if (allocated(noutcritpointsmax_cll)) deallocate(noutcritpointsmax_cll)
      allocate(noutcritpointsmax_cll(nmax_cll))
      noutcritpointsmax_cll = 50
    end if
 
  end subroutine initmaxcritpoints_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxCritPointsN_cll(npoints,N)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxcritpointsn_cll(npoints,N)
 
    integer, intent(in) :: npoints,N
 
    noutcritpointsmax_cll(n) = npoints
 
  end subroutine setmaxcritpointsn_cll
 
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine SetMaxCritPointsArray_cll(npoints)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine setmaxcritpointsarray_cll(npoints)
 
    integer, intent(in) :: npoints(Nmax_cll)
 
    noutcritpointsmax_cll = npoints
 
  end subroutine setmaxcritpointsarray_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine InfOut_cll(sub,inf,flag)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
! Suppression of output must be implemented in calling routines!
 
  subroutine infout_cll(sub,inf,flag)
 
    character(len=*), intent(in) :: sub, inf
    logical, intent(out) :: flag
!    integer, parameter :: maxErrOut=100
  
    flag = .false.
    if (infoutlev_cll.eq.0) return
 
    infcnt_cll = infcnt_cll + 1      
    if(ninfout_cll.ne.closed_cll) then
      if (infcnt_cll.le.maxinfout_cll) then
        write(ninfout_cll,*)
        write(ninfout_cll,*)
        write(ninfout_cll,*)
        write(ninfout_cll,*) '***********************************************************'
        write(ninfout_cll,*) 'Info-output NO.', infcnt_cll
        write(ninfout_cll,*) 'in routine: ', trim(sub)
        write(ninfout_cll,*) trim(inf)
!        call WriteMaster_cll(nerrout_cll)
        flag=.true.
      elseif (infcnt_cll.eq.maxinfout_cll+1) then
        write(ninfout_cll,*)
        write(ninfout_cll,*)
        write(ninfout_cll,*)
        write(ninfout_cll,*) '***********************************************************'
        write(ninfout_cll,*)
        write(ninfout_cll,*) ' Further output of information will be suppressed '
        write(ninfout_cll,*)
      endif
    endif
 
  end subroutine infout_cll    
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  function findFreeChannel_cll
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  function findfreechannel_cll()    result(nchan)
 
    integer :: nchan
    integer :: i
    logical :: qopened
    
    qopened = .true.
    i = 100
    do while (qopened.and.(i.le.1000))
      i=i+1
      inquire(i, opened=qopened)
    end do
    nchan = i
 
  end function findfreechannel_cll  
  
 
 
 
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenErrOutFile_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine openerroutfile_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
    
    ! close channel used so far
    if(nerrout_cll.ne.closed_cll) then
      inquire(nerrout_cll, opened=qopened)
      if(qopened.and.nerrout_cll.ne.stdout_cll) close(unit=nerrout_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      nerrout_cll = nchan
      ! return if output shall be written as standard output
      if (nerrout_cll.eq.stdout_cll) return      
      inquire(nerrout_cll, opened=qopened)
      if(qopened) close(unit=nerrout_cll)
    else
      nerrout_cll = findfreechannel_cll()
    end if     
    
    ! open file 'filename' as unit nerrout_cll
    fname_errout_cll = trim(filename)
    open(unit=nerrout_cll,file=trim(fname_errout_cll),form='formatted',access='sequential',status='replace')
   
    ! write intro
    call writeintro_cll(nerrout_cll)
    call date_and_time(date=da,time=ti)
    write(unit=nerrout_cll,fmt=*) '                                                           '
    write(unit=nerrout_cll,fmt=*) '***********************************************************'
    write(unit=nerrout_cll,fmt=*) '                                                           '
    write(unit=nerrout_cll,fmt=*) '   file containing the error output of COLLIER interface   '
    write(unit=nerrout_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=nerrout_cll,fmt=*) '                                                           '
    write(unit=nerrout_cll,fmt=*) '***********************************************************'
    write(unit=nerrout_cll,fmt=*) '                                                           '
 
  end subroutine openerroutfile_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenErrOutFileCOLI_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine openerroutfilecoli_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(nerroutcoli_cll.ne.closed_cll) then
      inquire(nerroutcoli_cll, opened=qopened)
      if(qopened.and.nerroutcoli_cll.ne.stdout_cll) close(unit=nerroutcoli_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      nerroutcoli_cll = nchan
      call setnerrout_coli(nerroutcoli_cll)      
      ! return if output shall be written as standard output
      if (nerroutcoli_cll.eq.stdout_cll) return      
      inquire(nerroutcoli_cll, opened=qopened)
      if(qopened) close(unit=nerroutcoli_cll)
    else
      nerroutcoli_cll = findfreechannel_cll()
      call setnerrout_coli(nerroutcoli_cll)      
    end if 
    
    ! open file 'filename' as unit nerroutcoli_cll
    fname_erroutcoli_cll = trim(filename)
    open(unit=nerroutcoli_cll,file=trim(fname_erroutcoli_cll),form='formatted',access='sequential',status='replace')
   
    ! write intro
    call writeintro_cll(nerroutcoli_cll)
    call date_and_time(date=da,time=ti)
    write(unit=nerroutcoli_cll,fmt=*) '                                                           '
    write(unit=nerroutcoli_cll,fmt=*) '***********************************************************'
    write(unit=nerroutcoli_cll,fmt=*) '                                                           '
    write(unit=nerroutcoli_cll,fmt=*) '       file containing the error output of COLI            '
    write(unit=nerroutcoli_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=nerroutcoli_cll,fmt=*) '                                                           '
    write(unit=nerroutcoli_cll,fmt=*) '***********************************************************'
    write(unit=nerroutcoli_cll,fmt=*) '                                                           '
 
  end subroutine openerroutfilecoli_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenErrOutFileDD_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine openerroutfiledd_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    integer :: outlevel_dd,outchannel_dd,mode34_dd,mode5_dd,mode6_dd
    double precision :: cacc_dd,dacc_dd
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(nerroutdd_cll.ne.closed_cll) then
      inquire(nerroutdd_cll, opened=qopened)
      if(qopened.and.nerroutdd_cll.ne.stdout_cll) close(unit=nerroutdd_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      nerroutdd_cll = nchan
      call  ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
      call  ddsetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,nerroutdd_cll)
      if (erroutlev_cll.gt.0) then
        call  ddsetcout_on(.true.)
      end if
      ! return if output shall be written as standard output
      if (nerroutdd_cll.eq.stdout_cll) return      
      inquire(nerroutdd_cll, opened=qopened)
      if(qopened) close(unit=nerroutdd_cll)
    else
      nerroutdd_cll = findfreechannel_cll()
      call  ddgetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,outchannel_dd)
      call  ddsetmode(cacc_dd,dacc_dd,mode34_dd,mode5_dd,mode6_dd,outlevel_dd,nerroutdd_cll)
      if (erroutlev_cll.gt.0) then
        call  ddsetcout_on(.true.)
      end if
    end if 
    
    ! open file 'filename' as unit nerroutdd_cll
    fname_erroutdd_cll = trim(filename)
    open(unit=nerroutdd_cll,file=trim(fname_erroutdd_cll),form='formatted',access='sequential',status='replace')
   
    ! write intro
    call writeintro_cll(nerroutdd_cll)
    call date_and_time(date=da,time=ti)
    write(unit=nerroutdd_cll,fmt=*) '                                                           '
    write(unit=nerroutdd_cll,fmt=*) '***********************************************************'
    write(unit=nerroutdd_cll,fmt=*) '                                                           '
    write(unit=nerroutdd_cll,fmt=*) '       file containing the error output of DD              '
    write(unit=nerroutdd_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=nerroutdd_cll,fmt=*) '                                                           '
    write(unit=nerroutdd_cll,fmt=*) '***********************************************************'
    write(unit=nerroutdd_cll,fmt=*) '                                                           '
 
  end subroutine openerroutfiledd_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenCritPointsOutFileCOLI_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine opencritpointsoutfilecoli_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(ncpoutcoli_cll.ne.closed_cll) then
      inquire(ncpoutcoli_cll, opened=qopened)
      if(qopened.and.ncpoutcoli_cll.ne.stdout_cll) close(unit=ncpoutcoli_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      ncpoutcoli_cll = nchan
      call setncpout_coli(ncpoutcoli_cll)      
      ! return if output shall be written as standard output
      if (ncpoutcoli_cll.eq.stdout_cll) return      
      inquire(ncpoutcoli_cll, opened=qopened)
      if(qopened) close(unit=ncpoutcoli_cll)
    else
      ncpoutcoli_cll = findfreechannel_cll()
      call setncpout_coli(ncpoutcoli_cll)      
    end if
        
    ! open file 'filename' as unit unit=ncpoutcoli_cll
    fname_cpoutcoli_cll = trim(filename)
    open(unit=ncpoutcoli_cll,file=trim(fname_cpoutcoli_cll),form='formatted',access='sequential',status='replace')
!    qopened_critcoli=.true.
   
    ! write intro
    call writeintro_cll(ncpoutcoli_cll)
    call date_and_time(date=da,time=ti)
    write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
    write(unit=ncpoutcoli_cll,fmt=*) '***********************************************************'
    write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
    write(unit=ncpoutcoli_cll,fmt=*) '     file containing problematic integrals of COLI         '
    write(unit=ncpoutcoli_cll,fmt=*) '     with errors estimated to be above a given limit       '
    write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
    write(unit=ncpoutcoli_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
    write(unit=ncpoutcoli_cll,fmt=*) '***********************************************************'
    write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
    write(unit=ncpoutcoli_cll,fmt='(A30,Es15.8)') &
        ' Critical precision: critacc =',critacc_cll 
    write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
    write(unit=ncpoutcoli_cll,fmt=*) '***********************************************************'
    write(unit=ncpoutcoli_cll,fmt=*) '                                                           '
 
 
  end subroutine opencritpointsoutfilecoli_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenCritPointsOutFile_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine opencritpointsoutfile_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(ncpout_cll.ne.closed_cll) then
      inquire(ncpout_cll, opened=qopened)
      if(qopened.and.ncpout_cll.ne.stdout_cll) close(unit=ncpout_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      ncpout_cll = nchan      
      ! return if output shall be written as standard output
      if (ncpout_cll.eq.stdout_cll) return      
      inquire(ncpout_cll, opened=qopened)
      if(qopened) close(unit=ncpout_cll)
    else
      ncpout_cll = findfreechannel_cll()      
    end if
    
    ! open file 'filename' as unit ncpout_cll
    fname_cpout_cll = trim(filename)
    open(unit=ncpout_cll,file=trim(fname_cpout_cll),form='formatted',access='sequential',status='replace')
!    qopened_crit=.true.
   
    ! write intro
    call writeintro_cll(ncpout_cll)
    call date_and_time(date=da,time=ti)
    write(unit=ncpout_cll,fmt=*) '                                                           '
    write(unit=ncpout_cll,fmt=*) '***********************************************************'
    write(unit=ncpout_cll,fmt=*) '                                                           '
    write(unit=ncpout_cll,fmt=*) '     file containing problematic integrals with            '
    write(unit=ncpout_cll,fmt=*) '     errors estimated to be above a given limit            '
    write(unit=ncpout_cll,fmt=*) '                                                           '
    write(unit=ncpout_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=ncpout_cll,fmt=*) '                                                           '
    write(unit=ncpout_cll,fmt=*) '***********************************************************'
    write(unit=ncpout_cll,fmt=*) '                                                           '
    write(unit=ncpout_cll,fmt='(A30,Es15.8)') &
        ' Critical precision: critacc =',critacc_cll 
    write(unit=ncpout_cll,fmt=*) '                                                           '
    write(unit=ncpout_cll,fmt=*) '***********************************************************'
    write(unit=ncpout_cll,fmt=*)                                         
 
  end subroutine opencritpointsoutfile_cll
 
  
  
  
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenCritPointsOutFile2_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine opencritpointsoutfile2_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(ncpout2_cll.ne.closed_cll) then
      inquire(ncpout2_cll, opened=qopened)
      if(qopened.and.ncpout2_cll.ne.stdout_cll) close(unit=ncpout2_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      ncpout2_cll = nchan      
      ! return if output shall be written as standard output
      if (ncpout2_cll.eq.stdout_cll) return      
      inquire(ncpout2_cll, opened=qopened)
      if(qopened) close(unit=ncpout2_cll)
    else
      ncpout2_cll = findfreechannel_cll()      
    end if
    
    ! open file 'filename' as unit ncpout2_cll
    fname_cpout2_cll = trim(filename)
    open(unit=ncpout2_cll,file=trim(fname_cpout2_cll),form='formatted',access='sequential',status='replace')
!    qopened_crit2=.true.
   
    ! write intro
    call writeintro_cll(ncpout2_cll)
    call date_and_time(date=da,time=ti)
    write(unit=ncpout2_cll,fmt=*) '                                                           '
    write(unit=ncpout2_cll,fmt=*) '***********************************************************'
    write(unit=ncpout2_cll,fmt=*) '                                                           '
    write(unit=ncpout2_cll,fmt=*) '     file containing problematic integrals with            '
    write(unit=ncpout2_cll,fmt=*) '     errors estimated to be above a given limit            '
    write(unit=ncpout2_cll,fmt=*) '                                                           '
    write(unit=ncpout2_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=ncpout2_cll,fmt=*) '                                                           '
    write(unit=ncpout2_cll,fmt=*) '***********************************************************'
    write(unit=ncpout2_cll,fmt=*) '                                                           '
    write(unit=ncpout2_cll,fmt='(A30,Es15.8)') &
        ' Critical precision: critacc =',critacc_cll
    write(unit=ncpout2_cll,fmt=*) '                                                           '
    write(unit=ncpout2_cll,fmt=*) '***********************************************************'
    write(unit=ncpout2_cll,fmt=*)                                         
  end subroutine opencritpointsoutfile2_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenCheckOutFile_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine opencheckoutfile_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(ncheckout_cll.ne.closed_cll) then
      inquire(ncheckout_cll, opened=qopened)
      if(qopened.and.ncheckout_cll.ne.stdout_cll) close(unit=ncheckout_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      ncheckout_cll = nchan   
      ! return if output shall be written as standard output
      if (ncheckout_cll.eq.stdout_cll) return      
      inquire(ncheckout_cll, opened=qopened)
      if(qopened) close(unit=ncheckout_cll)
    else
      ncheckout_cll = findfreechannel_cll()
    end if 
        
    ! open file 'filename' as unit ncheckout_cll
    fname_checkout_cll = trim(filename)
    open(unit=ncheckout_cll,file=trim(fname_checkout_cll),form='formatted',access='sequential',status='replace')
    qopened_check=.true.
 
    ! write intro
    call writeintro_cll(ncheckout_cll)
    call date_and_time(date=da,time=ti)
    write(unit=ncheckout_cll,fmt=*) '                                                          '
    write(unit=ncheckout_cll,fmt=*) '***********************************************************'
    write(unit=ncheckout_cll,fmt=*) '                                                           '
    write(unit=ncheckout_cll,fmt=*) '       file containing integrals which lead to             '
    write(unit=ncheckout_cll,fmt=*) '           different results in COLI and DD                '
    write(unit=ncheckout_cll,fmt=*) '                                                           '
    write(unit=ncheckout_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=ncheckout_cll,fmt=*) '                                                           '
    write(unit=ncheckout_cll,fmt=*) '***********************************************************'
    write(unit=ncheckout_cll,fmt=*) '                                                           '
    write(unit=ncheckout_cll,fmt='(A28,Es15.8)') &
        ' Check precision: checkacc =',checkacc_cll 
    write(unit=ncheckout_cll,fmt=*) '                                                           '
    write(unit=ncheckout_cll,fmt=*) '***********************************************************'
    write(unit=ncheckout_cll,fmt=*) '                                                           '
 
  end subroutine opencheckoutfile_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenInfOutFile_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine openinfoutfile_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(ninfout_cll.ne.closed_cll) then
      inquire(ninfout_cll, opened=qopened)
      if(qopened.and.ninfout_cll.ne.stdout_cll) close(unit=ninfout_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      ninfout_cll = nchan
      call setninfout_cache(ninfout_cll)      
      ! return if output shall be written as standard output
      if (ninfout_cll.eq.stdout_cll) return      
      inquire(ninfout_cll, opened=qopened)
      if(qopened) close(unit=ninfout_cll)
    else
      ninfout_cll = findfreechannel_cll()
      call setninfout_cache(ninfout_cll)      
    end if
    
    ! open file 'filename' as unit ninfout_cll
    fname_infout_cll = trim(filename)
    open(unit=ninfout_cll,file=trim(fname_infout_cll),form='formatted',access='sequential',status='replace')
 
    ! write intro
    call writeintro_cll(ninfout_cll)
    call date_and_time(date=da,time=ti)
    write(unit=ninfout_cll,fmt=*) '                                                          '
    write(unit=ninfout_cll,fmt=*) '***********************************************************'
    write(unit=ninfout_cll,fmt=*) '                                                           '
    write(unit=ninfout_cll,fmt=*) '       file containing the info output of COLLIER          '
    write(unit=ninfout_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=ninfout_cll,fmt=*) '                                                           '
    write(unit=ninfout_cll,fmt=*) '***********************************************************'
    write(unit=ninfout_cll,fmt=*) '                                                           '
 
  end subroutine openinfoutfile_cll
 
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenInfOutFileCOLI_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine openinfoutfilecoli_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) ::nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(ninfoutcoli_cll.ne.closed_cll) then
      inquire(ninfoutcoli_cll, opened=qopened)
      if(qopened.and.ninfoutcoli_cll.ne.stdout_cll) close(unit=ninfoutcoli_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      ninfoutcoli_cll = nchan
      call setninfout_coli(ninfoutcoli_cll)      
      ! return if output shall be written as standard output
      if (ninfoutcoli_cll.eq.stdout_cll) return      
      inquire(ninfoutcoli_cll, opened=qopened)
      if(qopened) close(unit=ninfoutcoli_cll)
    else
      ninfoutcoli_cll = findfreechannel_cll()
      call setninfout_coli(ninfoutcoli_cll)      
    end if
    
    ! open file 'filename' as unit ninfoutcoli_cll
    fname_infoutcoli_cll = trim(filename)
    open(unit=ninfoutcoli_cll,file=trim(fname_infoutcoli_cll),form='formatted',access='sequential')
   
    ! write intro
    call writeintro_cll(ninfoutcoli_cll)
    call date_and_time(date=da,time=ti)
    write(unit=ninfoutcoli_cll,fmt=*) '                                                          '
    write(unit=ninfoutcoli_cll,fmt=*) '***********************************************************'
    write(unit=ninfoutcoli_cll,fmt=*) '                                                           '
    write(unit=ninfoutcoli_cll,fmt=*) '          file containing info output of COLI              '
    write(unit=ninfoutcoli_cll,fmt=*) '                                                           '
    write(unit=ninfoutcoli_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=ninfoutcoli_cll,fmt=*) '                                                           '
    write(unit=ninfoutcoli_cll,fmt=*) '***********************************************************'
    write(unit=ninfoutcoli_cll,fmt=*) '                                                           '
 
  end subroutine openinfoutfilecoli_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine OpenStatisticsOutFileCOLI_cll(filename,nchan)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine openstatisticsoutfilecoli_cll(filename,nchan)
 
    character(len=*), intent(in) :: filename
    integer, optional, intent(in) :: nchan
    character(len=8) :: da
    character(len=10) :: ti
    logical :: qopened
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
     
    ! close channel used so far
    if(nstatsoutcoli_cll.ne.closed_cll) then
      inquire(nstatsoutcoli_cll, opened=qopened)
      if(qopened.and.nstatsoutcoli_cll.ne.stdout_cll) close(unit=nstatsoutcoli_cll)
    end if
 
    ! set new channel and close if open
    if (present(nchan)) then
      nstatsoutcoli_cll = nchan
      call setnstatsout_coli(nstatsoutcoli_cll)      
      ! return if output shall be written as standard output
      if (nstatsoutcoli_cll.eq.stdout_cll) return      
      inquire(nstatsoutcoli_cll, opened=qopened)
      if(qopened) close(unit=nstatsoutcoli_cll)
    else
      nstatsoutcoli_cll = findfreechannel_cll()
      call setnstatsout_coli(nstatsoutcoli_cll)      
    end if
 
    ! open file 'filename' as unit nstatsoutcoli_cll
    fname_statsoutcoli_cll = trim(filename)
    open(unit=nstatsoutcoli_cll,file=trim(fname_statsoutcoli_cll),form='formatted',access='sequential',status='replace')
!    qopened_statscoli=.true.
 
    ! write intro
    ! call WriteIntro_cll(nstatsoutcoli_cll)
    call date_and_time(date=da,time=ti)
    write(unit=nstatsoutcoli_cll,fmt=*) '                                                           '
    write(unit=nstatsoutcoli_cll,fmt=*) '***********************************************************'
    write(unit=nstatsoutcoli_cll,fmt=*) '                                                           '
    write(unit=nstatsoutcoli_cll,fmt=*) '       file containing statistics of calls in COLI         '
    write(unit=nstatsoutcoli_cll,fmt=*) '       of C and D integral reduction functions             '
    write(unit=nstatsoutcoli_cll,fmt=*) '                                                           '
    write(unit=nstatsoutcoli_cll,fmt=*) '               created  ', da(7:8), '/', da(5:6), '/', da(1:4),  &
                         '  ', ti(1:2), ':', ti(3:4)
    write(unit=nstatsoutcoli_cll,fmt=*) '                                                           '
    write(unit=nstatsoutcoli_cll,fmt=*) '***********************************************************'
    write(unit=nstatsoutcoli_cll,fmt=*) '                                                           '
 
  end subroutine openstatisticsoutfilecoli_cll
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine PrintStatisticscoli_cll(noutch)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine printstatisticscoli_cll(noutch)
 
    integer, intent(in) :: noutch
 
!    if (nout.ne.0) then 
!      call Setnstatsoutcoli_cll(nout)
!     call Setnstatsout_coli(nout)
!     if (nout.ne.6) then
!       call OpenStatisticsOutFileCOLI_cll('output_cll/StatisticsOut.coli')
!     end if
!    end if 
    
    ! return if output into files is suppressed
    if (nofiles_cll) return
    
     call openstatisticsoutfilecoli_cll(trim(foldername_cll)//'/StatisticsOut.coli',noutch)
 
     call printstatistics_coli
 
 
  end subroutine printstatisticscoli_cll
 
 
 
 
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  subroutine WriteIntro_cll(un)
  !
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
  subroutine writeintro_cll(un)
 
    integer, intent(in) :: un
    write(unit=un,fmt=*) '                                                           '
    write(unit=un,fmt=*) '        *******************************************        '
    write(unit=un,fmt=*) '        *              C O L L I E R              *        '
    write(unit=un,fmt=*) '        *                                         *        '
    write(unit=un,fmt=*) '        *        Complex One-Loop Library         *        ' 
    write(unit=un,fmt=*) '        *      In Extended Regularizations        *        '
    write(unit=un,fmt=*) '        *                                         *        '
    write(unit=un,fmt=*) '        *    by A.Denner, S.Dittmaier, L.Hofer    *        '
    write(unit=un,fmt=*) '        *                                         *        '
!   write(unit=un,fmt=*) '        *              version 1.1.x              *        '
    write(unit=un,fmt=*) '        *              version '//version_cll//'              *        '
    write(unit=un,fmt=*) '        *                                         *        '    
    write(unit=un,fmt=*) '        *******************************************        '
    write(unit=un,fmt=*) '                                                           ' 
 
  end subroutine writeintro_cll
 
 
end module collier_init