text:
 SUBROUTINE inpd04 (task, iwrit, elsnam, nelms)

 !   READ control DATA for element number 04 (TL CST++)

 USE ele04_db

 IMPLICIT NONE
 ! dummy arguments
 CHARACTER(len=*),INTENT(IN):: elsnam    ! element set name
 CHARACTER(len=*),INTENT(IN):: task      ! requested task
 INTEGER (kind=4) :: nelms,   & ! number of element sets
                     iwrit      ! flag to echo data input

 ! local variables
 LOGICAL :: oldset
 INTEGER (kind=4) :: nelem, nreqs, narch, nn

 TYPE (ele04_set), POINTER, SAVE  :: elset, anter

 IF (TRIM(task) == 'INPUT ') THEN
   ! check if list of sets and set exists and initializes
   CALL srch_ele04 (head, anter, elset, elsnam, oldset)
   IF (oldset) THEN    !if set exists
     CALL comm04 (1, nelem,  nreqs, narch, elsnam, elset)
     elset%lside = .NOT.elset%nodvo   !initializes flag to compute LSIDE
   ELSE                !set ELSNAM does not exist
     ALLOCATE (elset)       !reserve memory for set
     elset%gauss = .FALSE.  !initializes flag to compute Gauss constants
     CALL listen('INPD04')  !read a line
     nn = getint('NNODE ',4,' NUMBER OF ELEMENT NODES (4 ONLY)..')
     IF( nn /= nnode )CALL runend('TETRA: NNODE must be 4             ')
     nreqs=getint('NREQS ',0,' Gauss pt for stress time history..')
     elset%angdf(1) =getrea('ALPHA ',0d0,' First Euler Angle from X and Ortho')
     elset%angdf(2) =getrea('BETA  ',0d0,' Second Euler Angle from X and Orth')
     elset%angdf(3) =getrea('GAMMA ',0d0,' Third Euler Angle from X and Ortho')
     elset%nodvo  = .NOT.exists('STANDA')
     IF( elset%nodvo  )THEN
       WRITE(lures,"(/,5X,'Volume Approximation based on neighbours will be used')")
       nodvo = .TRUE.
       stab  =getrea('STABIL',stab,' Stabiliztion factor               ')
     ELSE
       WRITE(lures,"(/,5X,'STANDARD Approximation Strain) will be used')")
     END IF
     elset%btscal = getrea('BTSCAL',1d0,' Critical time increment scaler    ')
     elset%lside  = .NOT.elset%nodvo   !initializes flag to compute LSIDE
     IF(exists('SMALL'))THEN
       elset%small = .TRUE.
       WRITE(lures,"(' Green strains will be used if possible')")
     ELSE
       elset%small = .FALSE.
     END IF

     IF( nreqs > 0 )NULLIFY( elset%ngrqs )
     narch  =  0           !to check
     nelem  =  0           !new set, initializes number of elements

     !Initialize empty list Point both pointer to nothing
     CALL ini_ele04e (elset%head, elset%tail)
   END IF
   !  read new data or add to previous data
   CALL elmd04( nelem, elset%head, elset%tail, iwrit )
   elset%plstr = 0     ! do not compute plastic strains
   IF (.NOT.oldset) CALL rdreqs (ngaus,nreqs, elset%ngrqs, iwrit )

   CALL comm04(0, nelem,  nreqs, narch, elsnam, elset)
   ! add to the list of sets
   IF (.NOT.oldset) THEN
     CALL add_ele04 (elset, head, tail)
     nelms = nelms + 1 ! increased set counter for this element type
   END IF

 ELSE IF (TRIM(task) == 'RESTAR') THEN

   ALLOCATE (elset)          !initializes a list
   NULLIFY(elset%head)       !nullify head pointer
   !  read control parameters
   elset%sname = elsnam
   READ (51) elset%nelem, elset%nreqs, elset%narch, elset%gauss, &
       elset%plstr, elset%angdf, elset%btscal, elset%small, elset%nodvo
   CALL rest04 (elset%nelem,  elset%nreqs, elset%head, elset%tail, &
                elset%ngrqs)
   ! add to list of elements
   CALL add_ele04 (elset, head, tail)

 ELSE
   CALL runend('INPD04: NON-EXISTENT TASK .        ')
 END IF
 RETURN

 END SUBROUTINE inpd04

max_stars_repo_name: jerebenitez/IFE-simpact-openfoam

max_issues_repo_name: jerebenitez/IFE-simpact-openfoam

max_forks_repo_name: jerebenitez/IFE-simpact-openfoam


text:
      subroutine averageovertwoZ(fxn,p,msq)
      implicit none
      include 'constants.f'
      include 'ewcouple.f'
      include 'zcouple.f'
      include 'masses.f'
      integer kcount,jcount
      double precision msq(-nf:nf,-nf:nf),msq1(-nf:nf,-nf:nf),
     & p(mxpart,4),pout1(mxpart,4),pout(mxpart,4),statfac
      pout(:,:)=0d0
      msq(:,:)=0d0
C---sum over 36 values;
      do jcount=1,6
      call pgen(p,jcount,3,4,pout1)
      do kcount=1,6
      call pgen(pout1,kcount,5,6,pout)
      call fxn(pout,msq1)
      msq(:,:)=msq(:,:)+msq1(:,:)
      enddo
      enddo
      statfac=0.5d0
      msq(:,:)=msq(:,:)*(zwidth**2/(4d0*esq*(le**2+re**2)))**2*statfac
      return
      end

ext: f

max_stars_repo_name: tmartini/JHUGen

max_issues_repo_name: tmartini/JHUGen

max_forks_repo_name: tmartini/JHUGen


text:
module bondint

  !--------------------------------------------------------------------!
  ! This module contains the paramterization of the bond integrals (BI)!
  ! for tight-binding (TB) calculations.  BIs are integrals over cubic !
  ! harmonics (i.e. atomic-like orbitals) that are functions of the    !
  ! angular momentum l and the magnetic quantum number m:              !
  !                                                                    !
  ! cubic harmonics K(l,m)          bondint(l1,l2,|m|)                 !
  ! ======================          = int{ K(l1,m) Oper. K(l2,m) }     !
  !                                                                    !
  !   l   m   orbital               l1   l2   |m|   bond               !
  !   -------------------           ------------------------           !
  !   0   0   s                     0    0     0    ss sigma           !
  !   1   0   p_z                   0    1     0    sp sigma           !
  !   1   1   p_x                   0    2     0    sd sigma           !
  !   1  -1   p_y                   1    0     0    ps sigma           !
  !   2   0   d_{z^2}               1    1     0    pp sigma           !
  !   2   1   d_{xz}                1    1     1    pp pi              !
  !   2  -1   d_{yz}                1    2     0    pd sigma           !
  !   2   2   d_{x^2-y^2}           1    2     1    pd pi              !
  !   2  -2   d_{xy}                2    0     0    ds sigma           !
  !                                 2    1     0    dp sigma           !
  !                                 2    1     1    dp pi              !
  !                                 2    2     0    dd sigma           !
  !                                 2    2     1    dd pi              !
  !                                 2    2     2    dd delta           !
  !                                                                    !
  !--------------------------------------------------------------------!
  ! 2010-10-17 Alexander Urban (AU)                                    !
  !--------------------------------------------------------------------!

  use interpol, only: deriv2,     &
                      cs, cs_d1, cs_d2

  use io,       only: io_adjustl, &
                      io_lower,   &
                      io_upper

  implicit none
  save

  public  :: bi_init,              &
             bi_final,             &
             bi_bondint,           &
             bi_onsite,            &
             bi_pairpot,           &
             bi_tabulate,          &
             bi_set_onsitelevel,   &
             bi_get_isInit,        &
             bi_get_hasHmat,       &
             bi_get_hasSmat,       &
             bi_get_hasOmat,       &
             bi_get_hasV,          &
             bi_get_r_min,         &
             bi_get_r_max,         &
             bi_get_r_min_pot,     &
             bi_get_r_max_pot,     &
             bi_get_l_min,         &
             bi_get_l_max,         &
             bi_get_nbi,           &
             bi_get_bi,            &
             polynomial,           &
             chebypol,             &
             dchebypol,            &
             polyexp,              &
             polyexp_cut

  private :: bi_memory_index,      &
             bi_pot_idx,           &
             bi_tabulate_mat,      &
             bi_tabulate_pot,      &
             generate_bondint_IDs, &
             tab_chebychev,        &
             tab_polyexp

  !---------------------------- constants -----------------------------!
  ! NPNTS   : number of nodes for the spline interpolation             !
  !--------------------------------------------------------------------!

  integer,          parameter, private :: NPNTS = 50
  double precision, parameter, private :: EPS = 1.0d-10

  !--------------------------------------------------------------------!
  ! bi_isInit     : .true., if the module has been initialized         !
  !                                                                    !
  ! ibMat         : next index for matrix elements initialization      !
  ! nBonds        : number of different interactions                   !
  ! memSize       : dimension of the matrix elements arrays            !
  ! memSizePot    : dimension of the pair potential array              !
  !                                                                    !
  ! bi(l1,l2,|m|) : unique bond integral ID for angular momenta l1, l2 !
  !                 and unsigned value of the magn. quantum number m   !
  !                 note: |m| <= min(l1,l2)                            !
  ! nbi           : total number of those bond integral IDs            !
  ! biIdx(ibi, itype1, itype2)                                         !
  !               : matrix element index for the ibi-th bond between   !
  !                 types itype1 and itype2; ibi = bi(l1,l2,|m|)       !
  !                                                                    !
  ! bi_ntypes     : total number of atomic species                     !
  ! bi_l_min      : lowest appearing angular momentum                  !
  ! bi_l_max      : highest appearing angular momentum                 !
  ! bi_r_min      : lower radial cut-off for bond integral curves      !
  ! bi_r_max      : upper radial cut-off                               !
  !                                                                    !
  ! bi_hasHmat    : .true. if Hamilton matrix parameters are provided  !
  ! bi_hasSmat    : .true. if overlap matrix parameters are provided   !
  ! bi_hasOmat    : .true. if distance dependent on-site parameters    !
  !                 are provided                                       !
  ! bi_hasV       : .true., if pair potential parameters are available !
  !                                                                    !
  ! onsite_level(l, itype) : on-site level for angular momentum l and  !
  !                          atomic species number itype               !
  !                                                                    !
  ! R_mat(i)      : r values for the tabulated range for the matrix    !
  !                 elements                                           !
  ! H_mat(idx)    : Hamilton matrix elements parameters                !
  ! S_mat(idx)    : overlap/screening matrix elements parameters       !
  ! d2?_mat(idx)  : second derivatives of the matrix elements for      !
  !                 ? in {H, S, O}                                     !
  !                                                                    !
  ! R_pot(i)      : r values for the tabulated range of the pair pot.  !
  ! V_pot(idxv)   : pair potential parameters                          !
  !                                                                    !
  ! Storage of the parameter cvurves                                   !
  ! ================================                                   !
  !                                                                    !
  ! The parameter curves for the matrices (H, S or O) are interpolated !
  ! with cubic splines on NPNTS nodes.  Values for the NPNTS nodes are !
  ! stored in the 1-d arrays ?_mat and the 2nd derivatives (necessary  !
  ! for the calculation of the cubic splines) are stored in d2?_mat.   !
  !   To access parameters for the bond between elements A and B for   !
  ! angular momenta l1 and l2 and a given unsigned value of the magn.  !
  ! quantum number m:                                                  !
  !                                                                    !
  !   (1)  get the ID for this bond kind:                              !
  !        --> ibi = bi(l1, l2, |m|)                                   !
  !   (2)  get index for that bond kind between elements A and B       !
  !        --> idx = biIdx(ibi, itypeA, itypeB)                        !
  !        where itypeA and itypeB are the atomic species indices of   !
  !        A and B.                                                    !
  !   (3)  access the parameters:                                      !
  !        --> value = ?_mat(idx:idx+NPNTS-1)                          !
  !                                                                    !
  !--------------------------------------------------------------------!

  logical,                                         private :: bi_isInit = .false.

  integer,                                         private :: ibMat
  integer,                                         private :: ibOns
  integer,                                         private :: nBonds
  integer,                                         private :: nOns
  integer,                                         private :: memSize
  integer,                                         private :: memSizeOns
  integer,                                         private :: memSizePot

  integer,          dimension(:,:,:), allocatable, private :: bi
  integer,                                         private :: nbi
  integer,          dimension(:,:,:), allocatable, private :: biIdx
  integer,          dimension(:,:,:), allocatable, private :: onsIdx

  integer,                                         private :: bi_ntypes
  integer,                                         private :: bi_l_min
  integer,                                         private :: bi_l_max
  double precision,                                private :: bi_r_min
  double precision,                                private :: bi_r_max
  double precision,                                private :: bi_r_min_pot
  double precision,                                private :: bi_r_max_pot

  logical,                                         private :: bi_hasHmat
  logical,                                         private :: bi_hasSmat
  logical,                                         private :: bi_hasOmat
  logical,                                         private :: bi_hasV

  double precision, dimension(:,:),   allocatable, private :: onsite_level

  double precision, dimension(:), allocatable, target, private :: R_mat
  double precision, dimension(:), allocatable, target, private :: H_mat, d2H_mat
  double precision, dimension(:), allocatable, target, private :: S_mat, d2S_mat

  double precision, dimension(:), allocatable, target, private :: R_ons
  double precision, dimension(:), allocatable, target, private :: H_ons, d2H_ons

  double precision, dimension(:), allocatable,         private :: R_pot
  double precision, dimension(:), allocatable, target, private :: V_pot, d2V_pot

  interface bi_tabulate
     module procedure bi_tabulate_mat, bi_tabulate_pot
  end interface

contains

  !--------------------------------------------------------------------!
  !               module initialization and finalization               !
  !--------------------------------------------------------------------!

  subroutine bi_init(ntypes, nlmax, nl, l_of_il, r0, r1, hamilton, &
                     notb, onsite, r0pot, r1pot, pairpot)

    implicit none

    !------------------------------------------------------------------!
    ! ntypes            : number of atomic species                     !
    ! l_max             : highest angular momentum                     !
    ! nl(itype)         : num. angular momentum channels of type itype !
    ! l_of_il(il,itype) : il-th angular momentum of type itype         !
    ! r0, r1            : lower and upper cut-off for r                !
    ! notb              : .true., if overlap is parametrized           !
    ! onsite            : .true., if onsite elements are parametrized  !
    ! r0pot, r1pot      : r range for the pair potentials              !
    ! pairpot           : .true., if pair pot. parameters are available!
    !------------------------------------------------------------------!

    integer,                             intent(in) :: ntypes
    integer,                             intent(in) :: nlmax
    integer, dimension(ntypes),          intent(in) :: nl
    integer, dimension(nlmax, ntypes),   intent(in) :: l_of_il
    double precision,                    intent(in) :: r0, r1
    logical,                             intent(in) :: hamilton
    logical,                             intent(in) :: notb
    logical,                             intent(in) :: onsite
    double precision,                    intent(in) :: r0pot, r1pot
    logical,                             intent(in) :: pairpot

    integer          :: itype1, itype2, il1, il2, ipt
    integer          :: l1, l2, l_min, l_max
    double precision :: r, dr

    ! paramterizations provided:
    bi_hasHmat = hamilton
    bi_hasSmat = hamilton
    bi_hasOmat = onsite
    bi_hasV    = pairpot

    ibMat = 1
    ibOns = 1

    !-----------------------------------------!
    ! loop over all angular momentum channel  !
    ! combinations of all atom types          !
    ! --> count all possible bonds = nbonds   !
    !     determine min. angular mom. = l_min !
    !-----------------------------------------!

    nBonds = 0
    nOns   = 0

    l_min  = l_of_il(1, 1)
    l_max  = l_min

    do itype1 = 1, ntypes
    do il1 = 1, nl(itype1)
       l1     = l_of_il(il1, itype1)
       l_min  = min(l_min, l1)
       l_max  = max(l_max, l1)
       ! same type, same angular momentum:
       nBonds = nBonds + l1 + 1
       nOns   = nOns   + ntypes*(l1 + 1)
       ! same type, different angular momentum:
       do il2 = il1 + 1, nl(itype1)
          l2     = l_of_il(il2, itype1)
          nBonds = nBonds + min(l1,l2) + 1
          nOns   = nOns   + ntypes*(min(l1,l2) + 1)
       end do
       ! different type:
       do itype2 = itype1 + 1, ntypes
          ! bonds:
          do il2 = 1, nl(itype2)
             l2     = l_of_il(il2, itype2)
             nBonds = nBonds + min(l1,l2) + 1
          end do
       end do
    end do
    end do

    !----------------------------------------!
    ! number of different bond integrals     !
    ! and bond IDs:                          !
    !                                        !
    ! defined afterwards: nbi, bi(l1, l2, m) !
    !----------------------------------------!

    call generate_bondint_IDs(l_min, l_max)

    !-----------------!
    ! allocate memory !
    !-----------------!

    memSize    = NPNTS*nBonds
    memSizeOns = NPNTS*nOns
    memSizePot = (ntypes*(ntypes + 1))/2*NPNTS

    allocate( biIdx(nbi, ntypes, ntypes), onsIdx(nbi,ntypes,ntypes), &
              R_mat(NPNTS), onsite_level(l_min:l_max, ntypes) )

    if (hamilton) then
       allocate(H_mat(memSize), d2H_mat(memSize))
       H_mat(:)   = 0.0d0
       d2H_mat(:) = 0.0d0
    end if
    if (notb) then
       allocate(S_mat(memSize), d2S_mat(memSize))
       S_mat(:)   = 0.0d0
       d2S_mat(:) = 0.0d0
    end if
    if (onsite) then
       allocate(R_ons(NPNTS), H_ons(memSizeOns), d2H_ons(memSizeOns))
       H_ons(:)   = 0.0d0
       d2H_ons(:) = 0.0d0
    end if
    if (pairpot) then
       allocate(R_pot(NPNTS), V_pot(memSizePot), d2V_pot(memSizePot))
       V_pot(:)   = 0.0d0
       d2V_pot(:) = 0.0d0
    end if

    biIdx(1:nbi, 1:ntypes, 1:ntypes)  = 0
    onsIdx(1:nbi, 1:ntypes, 1:ntypes) = 0

    !------------------!
    ! list of r values !
    !------------------!

    ! matrix elements:
    dr = (r1 - r0)/dble(NPNTS - 1)
    r  = r0
    do ipt = 1, NPNTS
       R_mat(ipt) = r
       r = r + dr
    end do

    ! on-site contributions:
    if (onsite) R_ons(:) = R_mat(:)

    ! pair potentials:
    if (pairpot) then
       dr = (r1pot - r0pot)/dble(NPNTS - 1)
       r  = r0
       do ipt = 1, NPNTS
          R_pot(ipt) = r
          r = r + dr
       end do
    end if

    !--------------------!
    ! things to remember !
    !--------------------!

    bi_l_min     = l_min
    bi_l_max     = l_max
    bi_r_min     = r0
    bi_r_max     = r1
    bi_r_min_pot = r0pot
    bi_r_max_pot = r1pot
    bi_ntypes    = ntypes

    bi_isInit = .true.

  end subroutine bi_init

  !--------------------------------------------------------------------!

  subroutine bi_final()

    implicit none

    if (allocated(bi))           deallocate(bi)
    if (allocated(biIdx))        deallocate(biIdx)
    if (allocated(onsIdx))       deallocate(onsIdx)
    if (allocated(R_mat))        deallocate(R_mat)
    if (allocated(H_mat))        deallocate(H_mat, d2H_mat)
    if (allocated(S_mat))        deallocate(S_mat, d2S_mat)
    if (allocated(R_ons))        deallocate(R_ons)
    if (allocated(H_ons))        deallocate(H_ons, d2H_ons)
    if (allocated(R_pot))        deallocate(R_pot)
    if (allocated(V_pot))        deallocate(V_pot, d2V_pot)
    if (allocated(onsite_level)) deallocate(onsite_level)

    bi_isInit = .false.

  end subroutine bi_final

  !--------------------------------------------------------------------!
  !                      unique bond integral ID                       !
  !--------------------------------------------------------------------!

  subroutine generate_bondint_IDs(l_min, l_max)

    implicit none

    integer, intent(in) :: l_min, l_max

    integer :: l1, l2, m

    allocate(bi(l_min:l_max, l_min:l_max, 0:l_max))

    nbi = 0
    do l1 = l_min, l_max
    do l2 = l_min, l_max
    do m  = 0, min(l1, l2)
       nbi         = nbi + 1
       bi(l1,l2,m) = nbi
    end do
    end do
    end do

  end subroutine generate_bondint_IDs

  !--------------------------------------------------------------------!
  !       unique index for each combination of itype1 >= itype2        !
  !--------------------------------------------------------------------!

  function bi_pot_idx(itype1, itype2) result(idx)

    implicit none

    integer, intent(in) :: itype1, itype2
    integer             :: idx

    integer             :: it1, it2

    ! assert that type1 >= type2
    if (itype1 >= itype2) then
       it1 = itype1
       it2 = itype2
    else
       it1 = itype2
       it2 = itype1
    end if

    idx = (it1*(it1 - 1))/2 + it2 - 1
    idx = idx*NPNTS + 1

  end function bi_pot_idx

  !--------------------------------------------------------------------!
  !                   look up matrix element values                    !
  !--------------------------------------------------------------------!

  subroutine bi_bondint(x, itype1, itype2, l1, l2, m, H, S, O, dH, dS, DO)

    implicit none

    double precision,               intent(in)  :: x
    integer,                        intent(in)  :: itype1, itype2
    integer,                        intent(in)  :: l1, l2, m
    double precision, optional,     intent(out) :: H, dH, S, dS, O, dO

    integer          :: idx1H, idx2H, idx1S, idx2S, idx1O, idx2O
    double precision :: facH, facS, facO

    if (x < bi_r_min) then
       write(0,*) "Error: out of parametrized region for r = ", x
       stop
    end if

    ! retrieve memory indices:
    if (present(H) .or. present(dH)) then
       facH = 1.0d0
       call bi_memory_index('hamilton', itype1, itype2, l1, l2, m, &
                            idx1H, idx2H, facH)
    end if
    if (present(S) .or. present(dS)) then
       facS = 1.0d0
       call bi_memory_index('overlap', itype1, itype2, l1, l2, m, &
                            idx1S, idx2S, facS)
    end if
    if (present(O) .or. present(dO)) then
       facO = 1.0d0
       call bi_memory_index('onsite', itype1, itype2, l1, l2, m, &
                            idx1O, idx2O, facO)
    end if

    ! interpolate parameter curves:
    if (x > bi_r_max) then
       if (present(H))  H  = 0.0d0
       if (present(dH)) dH = 0.0d0
       if (present(S))  S  = 0.0d0
       if (present(dS)) dS = 0.0d0
       if (present(O))  O  = 0.0d0
       if (present(dO)) dO = 0.0d0
    else
       if (present(H)) then
          call cs(R_mat(1:NPNTS), H_mat(idx1H:idx2H), &
                  d2H_mat(idx1H:idx2H), NPNTS, x, H)
          H = facH*H
       end if
       if (present(dH)) then
          call cs_d1(R_mat(1:NPNTS), H_mat(idx1H:idx2H), &
                     d2H_mat(idx1H:idx2H), NPNTS, x, dH)
          dH = facH*dH
       end if
       if (present(S)) then
          call cs(R_mat(1:NPNTS), S_mat(idx1S:idx2S), &
                  d2S_mat(idx1S:idx2S), NPNTS, x, S)
          S = facS*S
       end if
       if (present(dS)) then
          call cs_d1(R_mat(1:NPNTS), S_mat(idx1S:idx2S), &
                     d2S_mat(idx1S:idx2S), NPNTS, x, dS)
          dS = facS*dS
       end if
       if (present(O)) then
          call cs(R_ons(1:NPNTS), H_ons(idx1O:idx2O), &
                  d2H_ons(idx1O:idx2O), NPNTS, x, O)
          O = facO*O
       end if
       if (present(dO)) then
          call cs_d1(R_ons(1:NPNTS), H_ons(idx1O:idx2O), &
                  d2H_ons(idx1O:idx2O), NPNTS, x, dO)
          dO = facO*dO
       end if
    end if

  end subroutine bi_bondint

  !--------------------------------------------------------------------!
  !                    look up pair potential value                    !
  !--------------------------------------------------------------------!

  subroutine bi_pairpot(x, itype1, itype2, V, dV)

    implicit none

    double precision,               intent(in)  :: x
    integer,                        intent(in)  :: itype1, itype2
    double precision, optional,     intent(out) :: V, dV

    integer          :: idx1, idx2

    idx1 = bi_pot_idx(itype1, itype2)
    idx2 = idx1 + NPNTS - 1

    if (x < bi_r_min_pot) then
       write(0,*) "Error: out of parametrized region for r = ", x
       stop
    end if

    if (x > bi_r_max_pot) then
       if (present(V))  V  = 0.0d0
       if (present(dV)) dV = 0.0d0
    else
       if (present(V)) then
          call cs(R_pot(1:NPNTS), V_pot(idx1:idx2), &
                  d2V_pot(idx1:idx2), NPNTS, x, V)
       end if
       if (present(dV)) then
          call cs_d1(R_pot(1:NPNTS), V_pot(idx1:idx2), &
                  d2V_pot(idx1:idx2), NPNTS, x, dV)
       end if
    end if

  end subroutine bi_pairpot

  !--------------------------------------------------------------------!
  !                       look up on-site level                        !
  !--------------------------------------------------------------------!

  function bi_onsite(l, itype) result(level)

    implicit none

    integer, intent(in) :: l
    integer, intent(in) :: itype
    double precision    :: level

    if ((l >= bi_l_min) .and. (l <= bi_l_max) .and. (itype <= bi_ntypes)) then
       level = onsite_level(l, itype)
    else
       write(0,*) "Warning: invalid request for onsite level in `bi_onsite'."
       level = 0.0d0
    end if

  end function bi_onsite

  !--------------------------------------------------------------------!
  !                         property requests                          !
  !                                                                    !
  ! Values of some variables can be accessed read-only via these       !
  ! functions.  See comments for variables (above) for explanations.   !
  !--------------------------------------------------------------------!

  function bi_get_isInit() result(val)
    implicit none
    logical :: val
    val = bi_isInit
  end function bi_get_isInit

  !--------------------------------------------------------------------!

  function bi_get_hasHmat() result(val)
    implicit none
    logical :: val
    val = bi_hasHmat
  end function bi_get_hasHmat

  !--------------------------------------------------------------------!

  function bi_get_hasSmat() result(val)
    implicit none
    logical :: val
    val = bi_hasSmat
  end function bi_get_hasSmat

  !--------------------------------------------------------------------!

  function bi_get_hasOmat() result(val)
    implicit none
    logical :: val
    val = bi_hasOmat
  end function bi_get_hasOmat

  !--------------------------------------------------------------------!

  function bi_get_hasV() result(val)
    implicit none
    logical :: val
    val = bi_hasV
  end function bi_get_hasV

  !--------------------------------------------------------------------!

  function bi_get_r_min() result(val)
    implicit none
    double precision :: val
    val = bi_r_min
  end function bi_get_r_min

  !--------------------------------------------------------------------!

  function bi_get_r_max() result(val)
    implicit none
    double precision :: val
    val = bi_r_max
  end function bi_get_r_max

  !--------------------------------------------------------------------!

  function bi_get_r_min_pot() result(val)
    implicit none
    double precision :: val
    val = bi_r_min_pot
  end function bi_get_r_min_pot

  !--------------------------------------------------------------------!

  function bi_get_r_max_pot() result(val)
    implicit none
    double precision :: val
    val = bi_r_max_pot
  end function bi_get_r_max_pot

  !--------------------------------------------------------------------!

  function bi_get_l_min() result(val)
    implicit none
    integer :: val
    val = bi_l_min
  end function bi_get_l_min

  !--------------------------------------------------------------------!

  function bi_get_l_max() result(val)
    implicit none
    integer :: val
    val = bi_l_max
  end function bi_get_l_max

  !--------------------------------------------------------------------!

  function bi_get_nbi() result(val)
    implicit none
    integer :: val
    val = nbi
  end function bi_get_nbi

  !--------------------------------------------------------------------!

  function bi_get_bi(l1, l2, m) result(val)
    implicit none
    integer, intent(in) :: l1, l2, m
    integer             :: val
    val = bi(l1,l2,m)
  end function bi_get_bi

  !--------------------------------------------------------------------!
  !                       fill parameter tables                        !
  !--------------------------------------------------------------------!

  subroutine bi_tabulate_mat(scheme, itype1, itype2, matrix, l1, l2, m, &
                             r0, r1, params, xscale, yscale)

    implicit none

    character(len=*),               intent(in) :: scheme
    integer,                        intent(in) :: itype1, itype2
    character(len=*),               intent(in) :: matrix
    integer,                        intent(in) :: l1, l2, m
    double precision,               intent(in) :: r0, r1
    double precision, dimension(:), intent(in) :: params
    double precision, optional,     intent(in) :: xscale, yscale

    double precision, dimension(:), pointer    :: A, d2A, R

    double precision :: xfac, yfac
    integer          :: idx1, idx2

    ! scaling factors (e.g. for unit conversion):
    if (present(xscale)) then
       xfac = xscale
    else
       xfac = 1.0d0
    end if
    if (present(yscale)) then
       yfac = yscale
    else
       yfac = 1.0d0
    end if

    ! check boundaries of r:
    if ((xfac*r0 < bi_r_min) .or. (xfac*r1 > bi_r_max)) then
       write(0,*) itype1, itype2, matrix, l1, l2, m, xfac*r0, xfac*r1
       write(0,*) "Error: out of distance interval in `bi_tabulate()'"
       stop
    end if

    ! retrieve memory positions:
    call bi_memory_index(matrix, itype1, itype2, l1, l2, m, idx1, idx2, yfac)

    ! select matrix elements' memory region:
    sel_matrix : select case(trim(io_upper(matrix)))
    case('H', 'HAMILTON', 'HOPPING')
       A   => H_mat(idx1:idx2)
       d2A => d2H_mat(idx1:idx2)
       R   => R_mat(:)
    case('S', 'OVERLAP', 'SCREENING')
       A   => S_mat(idx1:idx2)
       d2A => d2S_mat(idx1:idx2)
       R   => R_mat(:)
    case('O', 'ONSITE')
       A   => H_ons(idx1:idx2)
       d2A => d2H_ons(idx1:idx2)
       R   => R_ons(:)
    case default
       write(0,*) "Error: unknown matrix name in `bi_tabulate()': ", &
            trim(adjustl(matrix))
       return
    end select sel_matrix

    ! evaluate and store parameter functions:
    sel_scheme : select case(trim(io_lower(scheme)))
    case('chebychev')
       call tab_chebychev(params, r0, r1, xfac, yfac, R, A, d2A)
    case('csplines')
       call tab_csplines(params, r1, xfac, yfac, R, A, d2A)
    case('polyexp')
       call tab_polyexp(params, r1, xfac, yfac, R, A, d2A)
    case default
       write(0,*) "Error: unknown parameter scheme in `bi_tabulate()': ", &
            trim(adjustl(scheme))
       return
    end select sel_scheme

  end subroutine bi_tabulate_mat

  !--------------------------------------------------------------------!

  subroutine bi_tabulate_pot(scheme, itype1, itype2, pottype, &
                             r0, r1, params, xscale, yscale)

    implicit none

    character(len=*),               intent(in) :: scheme
    integer,                        intent(in) :: itype1, itype2
    character(len=*),               intent(in) :: pottype
    double precision,               intent(in) :: r0, r1
    double precision, dimension(:), intent(in) :: params
    double precision, optional,     intent(in) :: xscale, yscale

    double precision, dimension(:), pointer    :: A, d2A

    double precision :: xfac, yfac
    integer          :: idx

    ! scaling factors (e.g. for unit conversion):
    if (present(xscale)) then
       xfac = xscale
    else
       xfac = 1.0d0
    end if
    if (present(yscale)) then
       yfac = yscale
    else
       yfac = 1.0d0
    end if

    ! check boundaries of r:
    if ((xfac*r0 < bi_r_min_pot) .or. (xfac*r1 > bi_r_max_pot)) then
       write(0,*) xfac*r0, bi_r_min_pot, xfac*r1, bi_r_max_pot
       write(0,*) itype1, itype2, pottype
       write(0,*) "Error: out of distance interval in `bi_tabulate()'"
       stop
    end if

    ! index for the parameters entry:
    idx = bi_pot_idx(itype1, itype2)

    ! select potential type:
    select  case(trim(io_lower(pottype)))
    case('pairpot')
       A   => V_pot(idx:idx+NPNTS-1)
       d2A => d2V_pot(idx:idx+NPNTS-1)
    case default
       write(0,*) "Error: unknown potential type name in `bi_tabulate()': ", &
            trim(adjustl(pottype))
       return
    end select

    ! select evaluation routine:
    sel_scheme : select case(trim(io_lower(scheme)))
    case('chebychev')
       call tab_chebychev(params, r0, r1, xfac, yfac, R_pot, A, d2A)
    case('csplines')
       call tab_csplines(params, r1, xfac, yfac, R_pot, A, d2A)
    case('polyexp')
       call tab_polyexp(params, r1, xfac, yfac, R_pot, A, d2A)
    case default
       write(0,*) "Error: unknown parameter scheme in `bi_tabulate()': ", &
            trim(adjustl(scheme))
       return
    end select sel_scheme

  end subroutine bi_tabulate_pot

  !--------------------------------------------------------------------!
  !   standardize parameter order for itype1, itype2, l1, l2, m        !
  !                                                                    !
  ! Every bond parametrization is stored just once, but the symmetry   !
  ! with respect to the exchange of the atom types must be obeyed.     !
  !                                                                    !
  ! The following rules are used for (itype1, itype2, l1, l2, m)       !
  ! - itype1 <= itype2                                                 !
  ! - if (itype1 == itype2) ---> l1 <= l2                              !
  !                                                                    !
  ! For distance dependent on-site contributions there is NO SYMMETRY  !
  ! with respect to exchange of the atom type, because both orbitals   !
  ! are on the same atom on either one of the two atom types.  On the  !
  ! other hand only one l1/l2 combination has to be stored.            !
  !--------------------------------------------------------------------!

  subroutine bi_memory_index(dataType, itype1, itype2, l1,  l2, m, &
                             idx1, idx2, fac )

    implicit none

    !------------------------------------------------------------------!
    ! dataType       : currently either "hamilton", "overlap"          !
    !                  or "onsite" ("h", "s", "o")                     !
    ! itype1, itype2 : input atom types                                !
    ! l1, l2         : input angular momenta                           !
    ! m              : common magnetic quantum number                  !
    ! idx1, idx2     : memory range indices for the selected data type !
    ! fac            : scaling factor, that might change the sign      !
    !------------------------------------------------------------------!

    character(len=*), intent(in)    :: dataType
    integer,          intent(in)    :: itype1, itype2, l1, l2, m
    integer,          intent(out)   :: idx1, idx2
    double precision, intent(inout) :: fac

    integer :: it1, it2, il1, il2
    integer :: ibond

    select case(io_lower(trim(dataType)))

       !----------------------- bond integrals ------------------------!

    case('s','overlap','screening','h','hamilton','hopping')
       if (itype1 == itype2) then
          it1 = itype1
          it2 = itype2
          if (l1 <= l2) then
             il1 = l1
             il2 = l2
          else
             il1 = l2
             il2 = l1
             if (mod(il2-il1,2) == 1) fac = -fac
          end if
       else if (itype1 <= itype2) then
          it1 = itype1
          it2 = itype2
          il1 = l1
          il2 = l2
       else
          it1 = itype2
          it2 = itype1
          il1 = l2
          il2 = l1
          if (mod(abs(il2-il1),2) == 1) fac = -fac
       end if
       ibond = bi(il1, il2, m)

       if (biIdx(ibond, it1, it2) == 0) then
          if (ibMat > (memSize - NPNTS + 1)) then
             write(*,*) itype1, itype2
             write(*,*) trim(dataType), l1, l2, m
             write(0,*) "Error: allocated memory exceeded in `bondint' module."
             stop
          else
             biIdx(ibond, it1, it2) = ibMat
             ibMat = ibMat + NPNTS
          end if
       end if

       idx1 = biIdx(ibond, it1, it2)
       idx2 = biIdx(ibond, it1, it2) + NPNTS - 1

       !--------------------- on-site parameters ----------------------!

    case('o','onsite')
       it1 = itype1
       it2 = itype2
       if (l1 <= l2) then
          il1 = l1
          il2 = l2
       else
          il1 = l2
          il2 = l1
       end if
       ibond = bi(il1, il2, m)

       if (onsIdx(ibond, it1, it2) == 0) then
          if (ibOns > (memSizeOns - NPNTS + 1)) then
             write(*,*) itype1, itype2
             write(*,*) trim(dataType), l1, l2, m
             write(0,*) "Error: allocated memory exceeded in `bondint' module."
             stop
          else
             onsIdx(ibond, it1, it2) = ibOns
             ibOns = ibOns + NPNTS
          end if
       end if

       idx1 = onsIdx(ibond, it1, it2)
       idx2 = onsIdx(ibond, it1, it2) + NPNTS - 1

       !---------------------------------------------------------------!

    case default
       write(0,*) "Error: unknown data type in `bi_standard_index()': ", &
            trim(adjustl(dataType))
       stop
    end select

  end subroutine bi_memory_index

  !--------------------------------------------------------------------!
  !                        store on-site level                         !
  !--------------------------------------------------------------------!

  subroutine bi_set_onsitelevel(l, itype, level)

    implicit none

    integer,          intent(in) :: l
    integer,          intent(in) :: itype
    double precision, intent(in) :: level

    if ((l >= bi_l_min) .and. (l <= bi_l_max) .and. (itype <= bi_ntypes)) then
       onsite_level(l, itype) = level
    end if

  end subroutine bi_set_onsitelevel

  !--------------------------------------------------------------------!
  !                   parameter function evaluation                    !
  !--------------------------------------------------------------------!

  subroutine tab_chebychev(params, rmin, rcut, xfac, yfac, X, A, d2A)

    implicit none

    double precision, dimension(:),     intent(in)  :: params
    double precision,                   intent(in)  :: rmin, rcut
    double precision,                   intent(in)  :: xfac, yfac
    double precision, dimension(NPNTS), intent(in)  :: X
    double precision, dimension(NPNTS), intent(out) :: A, d2A

    integer          :: nparams, ncut
    integer          :: ipt
    double precision :: r, dA_1, dA_n

    nparams = size(params)

    ncut = NPNTS
    do ipt = 1, NPNTS
       r = X(ipt)/xfac
       if (r < rcut) then
          A(ipt)  = yfac*chebypol(r, rmin, rcut, nparams, params)
       else
          ncut = ipt - 1
          exit
       end if
    end do

    dA_1 = yfac*dchebypol(X(1)/xfac, rmin, rcut, nparams, params)
    dA_n = yfac*dchebypol(X(ncut)/xfac, rmin, rcut, nparams, params)

    call deriv2(X(1:ncut), A(1:ncut), ncut, dA_1, dA_n, d2A(1:ncut))

    if (ncut < NPNTS) then
       A(ncut+1:NPNTS)   = 0.0d0
       d2A(ncut+1:NPNTS) = 0.0d0
    end if

  end subroutine tab_chebychev

  !--------------------------------------------------------------------!

  subroutine tab_csplines(params, rcut, xfac, yfac, R, A, d2A)

    implicit none

    double precision, dimension(:),     intent(in)  :: params
    double precision,                   intent(in)  :: rcut
    double precision,                   intent(in)  :: xfac, yfac
    double precision, dimension(NPNTS), intent(in)  :: R
    double precision, dimension(NPNTS), intent(out) :: A, d2A

    integer          :: i, j, n, ipt, ncut
    double precision :: y1_1, y1_n, x0
    double precision, dimension(:), allocatable :: x, y, y2

    n = (size(params) - 2)/2
    y1_1 = params(1)
    y1_n = params(2)

    allocate(x(n), y(n), y2(n))

    j = 0
    do i = 3, size(params), 2
       j = j + 1
       x(j) = params(i)
       y(j) = params(i+1)
    end do
    call deriv2(x, y, n, y1_1, y1_n, y2)

    ncut = NPNTS
    do ipt = 1, NPNTS
       x0 = R(ipt)/xfac
       if (x0 < rcut) then
          call cs(x, y, y2, n, x0, A(ipt))
          A(ipt) = yfac*A(ipt)
       else
          ncut = ipt - 1
          exit
       end if
    end do
    call cs_d1(x, y, y2, n, R(1)/xfac, y1_1)
    call cs_d1(x, y, y2, n, R(ncut)/xfac, y1_n)
    y1_1 = yfac*y1_1
    y1_n = yfac*y1_n

    call deriv2(R(1:ncut), A(1:ncut), ncut, y1_1, y1_n, d2A(1:ncut))

    if (ncut < NPNTS) then
       A(ncut+1:NPNTS)   = 0.0d0
       d2A(ncut+1:NPNTS) = 0.0d0
    end if

    deallocate(x, y, y2)

  end subroutine tab_csplines

  !--------------------------------------------------------------------!

  subroutine tab_polyexp(params, rcut, xfac, yfac, X, A, d2A)

    implicit none

    double precision, dimension(:),     intent(in)  :: params
    double precision,                   intent(in)  :: rcut
    double precision,                   intent(in)  :: xfac, yfac
    double precision, dimension(NPNTS), intent(in)  :: X
    double precision, dimension(NPNTS), intent(out) :: A, d2A

    integer          :: order
    double precision :: r
    double precision :: y, dy, d2y, d3y
    double precision :: yc, dyc, d2yc, d3yc
    double precision :: fc, dfc, d2fc, d3fc
    double precision :: y1_1, y1_n
    integer          :: ipt, ncut

    order = size(params) - 2

    call polyexp(rcut, params(1), order, params(2:order+2), yc, dyc, d2yc, d3yc)

    ncut = NPNTS
    do ipt = 1, NPNTS
       r = X(ipt)/xfac
       if (r < rcut) then
          call polyexp(r, params(1), order, params(2:order+2), y, dy, d2y, d3y)
          call polyexp_cut(r, rcut, yc, dyc, d2yc, fc, dfc, d2fc, d3fc)
          A(ipt)   = yfac*(y   - fc)
       else
          ncut = ipt - 1
          exit
       end if
    end do

    call polyexp(X(1)/xfac, params(1), order, params(2:order+2), y, dy, d2y, d3y)
    call polyexp_cut(X(1)/xfac, rcut, yc, dyc, d2yc, fc, dfc, d2fc, d3fc)
    y1_1 = yfac*(dy - dfc)
    call polyexp(X(ncut)/xfac, params(1), order, params(2:order+2), y, dy, d2y, d3y)
    call polyexp_cut(X(ncut)/xfac, rcut, yc, dyc, d2yc, fc, dfc, d2fc, d3fc)
    y1_n = yfac*(dy - dfc)

    call deriv2(X(1:ncut), A(1:ncut), ncut, y1_1, y1_n, d2A(1:ncut))

    if (ncut < NPNTS) then
       A(ncut+1:NPNTS)     = 0.0d0
       d2A(ncut+1:NPNTS)   = 0.0d0
    end if

  end subroutine tab_polyexp

  !--------------------------------------------------------------------!

!!$  subroutine tab_polyexp(params, rcut, fac, X, A, d2A)
!!$
!!$    implicit none
!!$
!!$    double precision, dimension(:),     intent(in)  :: params
!!$    double precision,                   intent(in)  :: rcut
!!$    double precision,                   intent(in)  :: fac
!!$    double precision, dimension(NPNTS), intent(in)  :: X
!!$    double precision, dimension(NPNTS), intent(out) :: A, d2A
!!$
!!$    integer          :: order
!!$    double precision :: r
!!$    double precision :: y, dy, d2y, d3y
!!$    double precision :: yc, dyc, d2yc, d3yc
!!$    double precision :: fc, dfc, d2fc, d3fc
!!$    integer          :: ipt
!!$
!!$    order = size(params) - 2
!!$
!!$    call polyexp(rcut, params(1), order, params(2:order+2), yc, dyc, d2yc, d3yc)
!!$
!!$    do ipt = 1, NPNTS
!!$       r = X(ipt)
!!$       if (r < rcut) then
!!$          call polyexp(r, params(1), order, params(2:order+2), y, dy, d2y, d3y)
!!$          call polyexp_cut(r, rcut, yc, dyc, d2yc, fc, dfc, d2fc, d3fc)
!!$          A(ipt)   = fac*(y   - fc)
!!$          d2A(ipt) = fac*(d2y - d2fc)
!!$       else
!!$          A(ipt)   = 0.0d0
!!$          d2A(ipt) = 0.0d0
!!$       end if
!!$    end do
!!$
!!$  end subroutine tab_polyexp

  !--------------------------------------------------------------------!
  !                              polynomial                            !
  !--------------------------------------------------------------------!

  subroutine polynomial(x, order, coeff, y, dy, d2y, d3y)

    implicit none

    double precision,                     intent(in)  :: x
    integer,                              intent(in)  :: order
    double precision, dimension(0:order), intent(in)  :: coeff
    double precision,                     intent(out) :: y, dy, d2y, d3y

    integer          :: i

    ! polynomial:
    y = 0.0d0
    do i = order, 1, -1
       y = x*(coeff(i) + y)
    end do
    y = y + coeff(0)

    ! 1st derivative:
    dy = 0.0d0
    do i = order, 2, -1
       dy = x*(dble(i)*coeff(i) + dy)
    end do
    if (order >= 1) dy = dy + coeff(1)

    ! 2nd derivative:
    d2y = 0.0d0
    do i = order, 3, -1
       d2y = x*(dble(i*(i-1))*coeff(i) + d2y)
    end do
    if (order >= 2) d2y = d2y + 2.0d0*coeff(2)

    ! 3rd derivative:
    d3y = 0.0d0
    do i = order, 4, -1
       d3y = x*(dble(i*(i-1)*(i-2))*coeff(i) + d3y)
    end do
    if (order >= 3) d3y = d3y + 6.0d0*coeff(3)

  end subroutine polynomial

  !--------------------------------------------------------------------!
  !      Evaluate Chebyshev polynomial with coefficients c(1:n).       !
  !                 [see Numerical Recipes, Chapter 5.8]               !
  !--------------------------------------------------------------------!

  function chebypol(r, r0, r1, n, para) result(val)

    implicit none

    !------------------------------------------------------------------!
    ! r            : distance; para(1) <= r <= para(2)                 !
    ! r0, r1       : lower and upper boundaries                        !
    ! n            : number of coefficients                            !
    ! para(1...n)  : coefficients                                      !
    ! val          : value of the Chebychev polynomial                 !
    !------------------------------------------------------------------!

    double precision,               intent(in) :: r, r0, r1
    integer,                        intent(in) :: n
    double precision, dimension(n), intent(in) :: para
    double precision                           :: val

    integer                      :: i
    double precision             :: d1, d2, sv, y, y2

    val = 0.d0

    ! Change of variable (rescale to interval [-1,1]):
    y = (2.d0*r - r0 - r1)/(r1 - r0)
    y2 = 2.d0*y

    ! Evaluate Chebychev polynomial (Clenshaw's recurrence):
    d1 = 0.d0
    d2 = 0.d0
    do i = n, 2, -1
       sv = d1
       d1 = y2*d1 - d2 + para(i)
       d2 = sv
    end do
    val = y*d1 - d2 + 0.5d0*para(1)

  end function chebypol

  !--------------------------------------------------------------------!
  !         Evaluate the derivative of a Chebyshev polynomial          !
  !                     with coefficients c(1:n).                      !
  !             [see Numerical Recipes, Chapter 5.5 + 5.8]             !
  !--------------------------------------------------------------------!

  function dchebypol(r, r0, r1, n, para) result(dval)

    implicit none

    !------------------------------------------------------------------!
    ! r            : distance; para(1) <= r <= para(2)                 !
    ! r0, r1       : lower and upper boundaries                        !
    ! n            : number of parameters                              !
    ! para(1...n)  : coefficients                                      !
    ! dval         : derivative of the Chebychev polynomial            !
    !------------------------------------------------------------------!

    double precision,               intent(in) :: r, r0, r1
    integer,                        intent(in) :: n
    double precision, dimension(n), intent(in) :: para
    double precision                           :: dval

    integer                       :: i
    double precision              :: d1, d2, denom, sv, y2

    dval = 0.d0

    ! Change of variable (rescale to interval [-1,1]):
    denom = 2.D0/(r1 - r0)
    y2 = (2.d0*r - r0 - r1)*denom

    ! Evaluate derivative of Chebychev polynomial (Clenshaw's recurrence):
    d1 = 0.d0
    d2 = 0.d0
    do i = n, 3, -1
       sv = d1
       d1 = y2*d1 - d2 + dble(i-1)*para(i)
       d2 = sv
    enddo
    dval = y2*d1 - d2 + para(2)

    ! Renormalize (due to rescaling):
    dval = denom*dval

  end function dchebypol

  !--------------------------------------------------------------------!
  !                 polyexp = polynomial x exponential                 !
  !--------------------------------------------------------------------!

  subroutine polyexp(x, a, order, coeff, y, dy, d2y, d3y)

    implicit none

    double precision,                     intent(in)  :: x
    double precision,                     intent(in)  :: a
    integer,                              intent(in)  :: order
    double precision, dimension(0:order), intent(in)  :: coeff
    double precision,                     intent(out) :: y, dy, d2y, d3y

    double precision :: p, dp, d2p, d3p
    double precision :: expval

    call polynomial(x, order, coeff, p, dp, d2p, d3p)

    expval = exp(-a*x)

    y   = p*expval
    dy  = (dp - a*p)*expval
    d2y = (d2p - a*(2.0d0*dp - a*p))*expval
    d3y = (d3p - a*(3.0d0*d2p - a*(3.0d0*dp - a*p)))*expval

  end subroutine polyexp

  !--------------------------------------------------------------------!

  subroutine polyexp_cut(x, xcut, fc, dfc, d2fc, y, dy, d2y, d3y)

    implicit none

    double precision,                     intent(in)  :: x, xcut
    double precision,                     intent(in)  :: fc, dfc, d2fc
    double precision,                     intent(out) :: y, dy, d2y, d3y

    y   = fc + (x - xcut)*dfc + 0.5d0*(x - xcut)*(x - xcut)*d2fc
    dy  = dfc + (x - xcut)*d2fc
    d2y = d2fc
    d3y = 0

  end subroutine polyexp_cut

end module bondint

max_stars_repo_name: alexurba/cftb

max_issues_repo_name: alexurba/cftb

max_forks_repo_name: alexurba/cftb


text:
*----------------------------------------------------------------------*
      subroutine spin_prj_list_drv(label,s2,op_info,
     &                      str_info,strmap_info,orb_info)
*----------------------------------------------------------------------*
* driver for spin_prj_list
*----------------------------------------------------------------------*

      implicit none

      integer, parameter ::
     &     ntest = 00

      include 'stdunit.h'
      include 'opdim.h'
      include 'mdef_operator_info.h'
      include 'def_graph.h'
      include 'def_strinf.h'
      include 'def_orbinf.h'
      include 'def_strmapinf.h'
      include 'ifc_memman.h'
      include 'par_opnames_gen.h'

      character(len=*), intent(in) ::
     &     label
      integer, intent(in) ::
     &     s2
      type(operator_info), intent(inout) ::
     &     op_info
      type(strinf), intent(in) ::
     &     str_info
      type(strmapinf), intent(in) ::
     &     strmap_info
      type(orbinf), intent(in) ::
     &     orb_info

      integer ::
     &     ifree, idx
      real(8) ::
     &     cpu, sys, wall, cpu0, sys0, wall0, xdum

      type(me_list), pointer ::
     &     me
      integer, external ::
     &     idx_mel_list

      call atim_csw(cpu0,sys0,wall0)

      ifree = mem_setmark('spin_prj_mel')

      idx = idx_mel_list(label,op_info)
      if (idx.lt.0) call quit(1,'spin_prj_list_drv',
     &                           'label not on list: '//trim(label))
      me => op_info%mel_arr(idx)%mel

      call spin_prj_list(1.0,me,me,s2,
     &     xdum,.false.,
     &     op_info,str_info,strmap_info,orb_info)

      ifree = mem_flushmark('spin_prj_mel')

      call atim_csw(cpu,sys,wall)

      call prtim(lulog,'time for spin-projecting ME-list ',
     &                cpu-cpu0,sys-sys0,wall-wall0)

      return
      end

max_stars_repo_name: ak-ustutt/GeCCo-public

max_issues_repo_name: ak-ustutt/GeCCo-public

max_forks_repo_name: ak-ustutt/GeCCo-public


text:
Describe Users/PerkyWorld12345 here.

20100626 23:21:21 nbsp Hi Perky, and welcome to the wiki!  I notice you made an edit to the Irvine wiki, as well as adding some info on SickSpits.  Should I be welcoming you to Davis, as well?  Regardless, why not take a moment to identity introduce yourself on this page? Users/TomGarberson

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
      INTEGER FUNCTION fortranwrite (IUNIT, STRING)
C
C     Interface routine for C/C++ functions to write to a file
C     under FORTRAN
!      use ifcore
C
      INTEGER IUNIT
      CHARACTER STRING*(*)
C
      INTEGER ISTAT
C
      WRITE (IUNIT, 20, IOSTAT=ISTAT) STRING
 20   FORMAT(A)
      fortranwrite = ISTAT
!      ISTAT = COMMITQQ(IUNIT)
C
      RETURN
      END

max_stars_repo_name: HydrologicEngineeringCenter/heclib

max_issues_repo_name: HydrologicEngineeringCenter/heclib

max_forks_repo_name: HydrologicEngineeringCenter/heclib


!
!  Copyright 2016 ARTED developers
!
!  Licensed under the Apache License, Version 2.0 (the "License");
!  you may not use this file except in compliance with the License.
!  You may obtain a copy of the License at
!
!      http://www.apache.org/licenses/LICENSE-2.0
!
!  Unless required by applicable law or agreed to in writing, software
!  distributed under the License is distributed on an "AS IS" BASIS,
!  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
!  See the License for the specific language governing permissions and
!  limitations under the License.
!
subroutine init_Ac_ms_basis_expansion
  use global_variables
  use ms_maxwell_ks_variables
  implicit none
  integer :: iter, ix
  real(8) :: tt
  real(8) :: f0_1,f0_2,omega_1,omega_2,tpulse_1,tpulse_2,T1_T2

  if(myrank == 0)write(*,"(A)")"== Start: Initialization of vector potential."
  allocate(Ac_m(nx_s:nx_e), jt_m(Mx))
  allocate(jt_old_m(Mx), jt_old2_m(Mx))
  allocate(Ac_m_n(nx_s:nx_e), Ac_m_o(nx_s:nx_e))
  allocate(x_m(nx_s:nx_e))

  do ix = nx_s, nx_e
    x_m(ix) = ix*dx_m -0.5d0*dx_m
  end do

  Ac_m = 0d0
  Ac_m_o = 0d0

  f0_1=5.338d-9*sqrt(IWcm2_1)      ! electric field in a.u.
  omega_1=omegaev_1/(2d0*Ry)  ! frequency in a.u.
  tpulse_1=tpulsefs_1/0.024189d0 ! pulse duration in a.u.
  f0_2=5.338d-9*sqrt(IWcm2_2)      ! electric field in a.u.
  omega_2=omegaev_2/(2d0*Ry)  ! frequency in a.u.
  tpulse_2=tpulsefs_2/0.024189d0 ! pulse duration in a.u.
  T1_T2=T1_T2fs/0.024189d0 ! pulse duration in a.u.

  select case(laser_type)
  case('cos2cos')
! pump
    do ix = nx_s, nx_e

!t=0
      tt = 0d0 -x_m(ix)/clight-0.5d0*tpulse_1
      if(abs(tt)<0.5d0*tpulse_1)then
        Ac_m(ix) = -f0_1/omega_1*cos(pi*tt/tpulse_1)**2*sin(omega_1*tt)
      end if

!t=-dt
      tt = -dt_m -x_m(ix)/clight-0.5d0*tpulse_1
      if(abs(tt)<0.5d0*tpulse_1)then
        Ac_m_o(ix) = -f0_1/omega_1*cos(pi*tt/tpulse_1)**2*sin(omega_1*tt)
      end if

    end do
! pump
    do ix = nx_s, nx_e

!t=0
      tt = 0d0 -x_m(ix)/clight-0.5d0*tpulse_1 - T1_T2
      if(abs(tt)<0.5d0*tpulse_2)then
        Ac_m(ix) = Ac_m(ix) -f0_2/omega_2*cos(pi*tt/tpulse_2)**2*sin(omega_2*tt)
      end if

      tt = -dt_m -x_m(ix)/clight-0.5d0*tpulse_1 - T1_T2
      if(abs(tt)<0.5d0*tpulse_2)then
        Ac_m_o(ix) = Ac_m_o(ix) -f0_2/omega_2*cos(pi*tt/tpulse_2)**2*sin(omega_2*tt)
      end if

    end do

  case('cos4cos')
! pump
    do ix = nx_s, nx_e

!t=0
      tt = 0d0 -x_m(ix)/clight-0.5d0*tpulse_1
      if(abs(tt)<0.5d0*tpulse_1)then
        Ac_m(ix) = -f0_1/omega_1*cos(pi*tt/tpulse_1)**4*sin(omega_1*tt)
      end if

!t=-dt
      tt = -dt_m -x_m(ix)/clight-0.5d0*tpulse_1
      if(abs(tt)<0.5d0*tpulse_1)then
        Ac_m_o(ix) = -f0_1/omega_1*cos(pi*tt/tpulse_1)**4*sin(omega_1*tt)
      end if

    end do
! pump
    do ix = nx_s, nx_e

!t=0
      tt = 0d0 -x_m(ix)/clight-0.5d0*tpulse_1 - T1_T2
      if(abs(tt)<0.5d0*tpulse_2)then
        Ac_m(ix) = Ac_m(ix) -f0_2/omega_2*cos(pi*tt/tpulse_2)**4*sin(omega_2*tt)
      end if

      tt = -dt_m -x_m(ix)/clight-0.5d0*tpulse_1 - T1_T2
      if(abs(tt)<0.5d0*tpulse_2)then
        Ac_m_o(ix) = Ac_m_o(ix) -f0_2/omega_2*cos(pi*tt/tpulse_2)**4*sin(omega_2*tt)
      end if

    end do
  case('Acos2_4')
! pump
    do ix = nx_s, nx_e

!t=0
      tt = 0d0 -x_m(ix)/clight-0.5d0*tpulse_1
      if(abs(tt)<0.5d0*tpulse_1)then
        Ac_m(ix) = -f0_1/omega_1*cos(pi*tt/tpulse_1)**2*sin(omega_1*tt)
      end if

!t=-dt
      tt = -dt_m -x_m(ix)/clight-0.5d0*tpulse_1
      if(abs(tt)<0.5d0*tpulse_1)then
        Ac_m_o(ix) = -f0_1/omega_1*cos(pi*tt/tpulse_1)**2*sin(omega_1*tt)
      end if

    end do
! pump
    do ix = nx_s, nx_e

!t=0
      tt = 0d0 -x_m(ix)/clight-0.5d0*tpulse_1 - T1_T2
      if(abs(tt)<0.5d0*tpulse_2)then
        Ac_m(ix) = Ac_m(ix) -f0_2/omega_2*cos(pi*tt/tpulse_2)**4*sin(omega_2*tt)
      end if

      tt = -dt_m -x_m(ix)/clight-0.5d0*tpulse_1 - T1_T2
      if(abs(tt)<0.5d0*tpulse_2)then
        Ac_m_o(ix) = Ac_m_o(ix) -f0_2/omega_2*cos(pi*tt/tpulse_2)**4*sin(omega_2*tt)
      end if

    end do
  case default
    err_message='error in init_Ac'
    call err_finalize
  end select

  if(myrank == 0)write(*,"(A)")"== End: Initialization of vector potential."

  return
end subroutine init_Ac_ms_basis_expansion


text:
MODULE Blowers

  USE Types
  USE DefUtils
  IMPLICIT NONE

  LOGICAL :: Visited = .FALSE.
  REAL(KIND=dp) :: x1,y1,r1,x2,y2,r2,vx1,vy1,vx2,vy2

  SAVE :: Visited,x1,y1,r1,x2,y2,r2,vx1,vy1,vx2,vy2

CONTAINS

  FUNCTION InsideBlower(Model,n) RESULT ( BlowerInd )
    INTEGER :: n
    INTEGER :: BlowerInd
    TYPE(Model_t) :: Model

    REAL(KIND=dp) :: x,y
    TYPE(Valuelist_t), POINTER :: List

    x = Model % Nodes % x(n)
    y = Model % Nodes % y(n)

    IF(.NOT. Visited ) THEN
      List => Model % Simulation
      x1 = GetCReal( List,'Blower 1 x')
      y1 = GetCReal( List,'Blower 1 y')
      r1 = GetCReal( List,'Blower 1 r')
      vx1 = GetCReal( List,'Blower 1 vx')
      vy1 = GetCReal( List,'Blower 1 vy')
      PRINT *,'Blower 1:',x1,y1,r1,vx1,vy1

      x2 = GetCReal( List,'Blower 2 x')
      y2 = GetCReal( List,'Blower 2 y')
      r2 = GetCReal( List,'Blower 2 r')
      vx2 = GetCReal( List,'Blower 2 vx')
      vy2 = GetCReal( List,'Blower 2 vy')
      PRINT *,'Blower 1:',x2,y2,r2,vx2,vy2

      Visited = .TRUE.
    END IF

    IF( (x-x1)**2 + (y-y1)**2 < r1**2 ) THEN
      BlowerInd = 1
    ELSE IF( (x-x2)**2 + (y-y2)**2 < r2**2 ) THEN
      BlowerInd = 2
    ELSE
      BlowerInd = 0
    END IF

  END FUNCTION InsideBlower

END MODULE Blowers

FUNCTION BlowerVelox( Model, n, t ) RESULT(f)
  USE Types
  USE DefUtils
  USE Blowers

  IMPLICIT NONE

  TYPE(Model_t) :: Model
  INTEGER :: n
  REAL(KIND=dp) :: t,f

  INTEGER :: ind

  ind = InsideBlower(Model, n)
  IF( ind == 1 ) THEN
    f = vx1
  ELSE IF( ind == 2 ) THEN
    f = vx2
  ELSE
    f = 0.0_dp
  END IF
END FUNCTION BlowerVelox

FUNCTION BlowerVeloy( Model, n, t ) RESULT(f)
  USE Types
  USE DefUtils
  USE Blowers

  IMPLICIT NONE

  TYPE(Model_t) :: Model
  INTEGER :: n
  REAL(KIND=dp) :: t,f

  INTEGER :: ind

  ind = InsideBlower(Model, n)
  IF( ind == 1 ) THEN
    f = vy1
  ELSE IF( ind == 2 ) THEN
    f = vy2
  ELSE
    f = 0.0_dp
  END IF
END FUNCTION BlowerVeloy

FUNCTION BlowerVeloCond( Model, n, t ) RESULT(f)
  USE Types
  USE DefUtils
  USE Blowers

  IMPLICIT NONE

  TYPE(Model_t) :: Model
  INTEGER :: n
  REAL(KIND=dp) :: t,f

  INTEGER :: ind

  ind = InsideBlower(Model, n)
  IF( ind > 0 ) THEN
    f = 1.0_dp
  ELSE
    f = -1.0_dp
  END IF
END FUNCTION BlowerVeloCond

max_stars_repo_name: readex-eu/readex-apps

max_issues_repo_name: jcmcmurry/pipelining

max_forks_repo_name: jcmcmurry/pipelining


text:
All About Towing is one of several businesses in Davis to provide towing services. If your car breaks down, you may want to call them to tow it to an automobile repair auto shop. Visit their web site at http://www.allabouttowing.us.  At the request of a property owner or the police, they may also tow and store your vehicle if it is parked illegally. If they have towed your vehicle against your wishes you may want to take a look at If Your Car is Being Towed for general advice on how to handle the situation.

If you have been towed by them, they will register your vehicle and call you if they tow it again so that you avoid storage fees.

Patrol Plus Private Security partners with All About Towing to have vehicles without Residential Parking Permits parking permits removed from certain Apartments apartment complexes.

For more information on towing, see http://www.dmv.ca.gov/pubs/vctop/d11/vc22658.htm CVC 22658

20061202 16:57:37 nbsp Avoid this company at all costs.  The driver (and presumably the owner) is a complete jerk, and takes any and every opportunity to levy charge after charge on college students who dont have a spare $300 laying around.  If your car is towed on Friday night, you have the choice to wait until Monday to pick it up, in which case hell charge you for two days of storage, or if you want it back the next morning, hell charge you an afterhours fee, which ends up costing the same as leaving it there all weekend.     Users/CameronYoung

20070119 05:26:46 nbsp 2007118 car towed this afternoon, didnt call till late, picking up tommorow at 8am, will be within 24 hours, cant pick up tonight without additional fee, out $220 for my stupididy in parking choice Users/ErikBoehm

20070123 02:37:01 nbsp dpd had my car towed for being out of registration. $220. $180 towing + $40 storage for 24 hrs. moral: dont get your car towed. Users/CaptainRush

20070216 14:37:30 nbsp Total scam artist. AVOID AT ALL COST!!! I feel pity on anyone who gets their car towed from an apartment complex by these people. They totally damaged my car and blamed it on me for my parking job. STAY AWAY!!!  Users/SteveCarson

20070217 10:28:34 nbsp here is a suggestion to avoid this company at all costs: dont park your car in private parking lots that you are not authorized to park in.  Users/JeffIto

20070424 11:21:07 nbsp http://www.dmv.ca.gov/pubs/vctop/d11/vc22658.htm   They charged me $220. I am going to try to make sure that they have not charged me excessively. Users/AnnThiNguyen

20070529 03:52:32 nbsp Cruel company! Their fees are ridiculous!
In my apt complex, there are a few parking spots that serve as Future Resident Parking until 6pm, when they become normal guest spots. I parked there on a Saturday at 5:47pm thinking it was only going to be a few minutes till 6 anyway. Well at 6:12pm, I noticed my car was gone. The only way they knew I wasnt a future resident was because the leasing office was closed at the time!
I really felt sorry for the owner of the red car parked next to me. When I was out in the parking lot, the tow truck returned to remove the red car, which was parked next to mine.  It was as if the tow truck driver took down the license plate of the red car before 6pm, towed my car, then came back AFTER 6pm to tow the other car!
I understand that I broke the rules a little and parked where I shouldnt have but how could these moneygrubbers be so stiff!? When I went to bail my car out, I had to pay almost $300 in towing & storage fees because I couldnt pick it up till Monday.  They were so rude too. They acted so cold and really treated me like a criminal.. I guess I was a criminal in a way, but youd think they could give some college students a break, especially for parking 13 minutes in an office spot.
Oh why couldnt Johnnys Towing Service tow me instead?  Users/BenjaminCatabas

20071114 12:00:41 nbsp Most people never have their vehicles towed and stored. We are called the bad guys and many other things by the owners of the vehicles that get towed and stored.  It is the poor decisions that the vehicle owners make that lead to the vehicle being towed.  If the irresponsible owner fails to renew their registration, drives while intoxicated, or drives without a license the police departments will have us tow the vehicle.  We are the good guys to the police departments who keep our roadways safe.  If the inconsiderate driver parks in a restricted location, they should expect that their vehicle will be towed.  We are the good guys to businesses who want to provide parking spaces to their customers.  We are the good guys to tenants who want access to their reserved parking spaces.  We are the good guys to apartment complex managers that need to get the fire lanes open for emergency equipment and the handicapped spaces open for people with special needs.

As to the postings on this web site, we do not show that we ever towed a vehicle for Cameron Young, Steve Carson, Jeff Ito or Ann Thi Nguyen (possibly the same person with different aliases).  We do show that we towed Erick Boehm’s and Benjamin Catabas’s vehicles.  The tenant on Drake Drive that pays for the reserved parking space requested that we tow Erik’s car out of their space.  The manager of the apartment complex on 5th Street had us tow Benjamin’s car for parking in a reserved space.

Yes, towing rates are expensive, but operating a towing business is expensive, especially in Davis.  Real estate is expensive.  Business and residential rental rates, insurance, gasoline, vehicle maintenance and repair, wages, and providing 24/7 service are also expensive.  Consequently it is expensive to live and operate a business in Davis.

So bottom line, it is the driver’s poor decisions that initiate their vehicle being towed.  Obey the laws and heed the warning signs and your car won’t be towed.  If you make the wrong choices, your vehicle may be towed.  If your vehicle is towed, it will be expensive to get it back, but stop complaining and take responsibility for your actions.  But most importantly, make the right decisions and you will probably never have your vehicle towed.
 Users/RandyRoss
    Word up Randy, thats some sensible points you make, and I like how you guys obviously have meticulous records Users/StevenDaubert

    I agree people should be considerate & not park in assigned spaces but Office Parking hours were from 6am6pm. Offices closed at 4pm on Saturdays (Perhaps Greystone shouldve given me my money back). I parked at 5:47. My tow receipt says I was towed at 6pm. I thought I was past this little incident but I found my receipt while cleaning my desk today... and whenever I see that $280, its dumb but it still really pops my corn! Users/BenjaminCatabas

20071217 20:09:32 nbsp Know your rights: http://www.dmv.ca.gov/pubs/vctop/d11/vc22658.htm
If you were towed illegally, the property owner who had you towed is liable for twice what you were charged (dont take it out on the tow truck guys, theyre just doing as asked).
If you catch them towing you before they leave the property, they must release your vehicle for half price (if you ask).
If they damage your vehicle, they are liable for repairs. Users/JenniferKucich

20080505 12:21:01 nbsp Company is a joke and very frustrating. Employees are your stereotypical tow truck drivers. Very hard to work with, or have any type of legitimate communication. The fees are ridiculous. Basically dont park your car in a park lot you dont have a permit for. The guys are just doing there job, however they are idiots so it makes the whole process difficult, frustrating, and expensive. Users/armaraglia

20081104 14:18:24 nbsp I actually had a really great experience with this company this morning.  My car was towed last night due to the assholes at Cartridge World, and they released my vehicle to me for free because they said their driver only waited 58 minutes to tow my vehicle and he had to wait 60 minutes.  I think they were really just being nice due to the amount of times I called them and was fighting my case. Users/AllanRae

20090115 14:59:50 nbsp $220 to tow a car a few blocks is excessive.  The problem is, the people who ask for a vehicle to be towed dont care how much it costs, and the vehicle owner has no control over the price of the towing.  Therefore... Randy can charge whatever the heck he wants without having anyone regulate his pricing.  There should be oversight for businesses like this.   Users/MTills

I disagree. If someone had the right to tow you, as in, you were in their spot that they probably pay for, then you deserve to be towed. I towed people at Greystone because I would have had someone in my spot everyday if I didnt. Seriously, be considerate. AmLin
Yeah, people really shouldnt park in reserved spots.. they do deserve to be towed. However, I can think of 3 times when I went door to door asking who parked in my spot because Id rather they moved their car rather than deal with the nightmare that is All About Towing. I say: use towing as a deserved consequence, but also as a last resort.

20090204 14:03:56 nbsp protect your right at: www.rtstow.com/pdf/cttaguide.pdf (California Assembly Bill 2210 ) and www.yolo.courts.ca.gov/SmallClaims Users/seyed

20090320 17:16:04 nbsp Had my car towed last night for parking in The Drake without a permit. Sucks...
But the employee I dealt with today was very polite and courteous; I was in and out in about 5 minutes. Users/JaredS

20090324 13:10:48 nbsp Ok people need to get over themselves! Yes being towed sucks but it really is our fault if we get towed. I was towed yesterday and there goes my rent check but if you want your car back then you have to pay. I had no problems with these guys yes it is pricey but I didnt really notice my car was gone until 3AM so I called and got an immediate response. They really do answer at any time of night or day! Thanks for keeping my car safe for the night I hope we never do business again! Users/michaelkelley

20090424 15:21:23 nbsp All About Incompetence: they towed my car even though Im a RESIDENT with a VALID PERMIT! I live in Allegre Apartments and recently got a new car. I dont have license plates for it yet, so I got a temporary permit from the office until the plates come in. I put the permit in clear and plain sight and it explicitly states Allegre Temporary Parking Permit with a permit number on it. Whats more? Just two nights before, I caught one of their workers looking at my car around 1 a.m. with a flashlight. I walked up to him and he asked me if it was my car. When I said yes, he went on to explain to me how I needed a permit to park there. I just pointed to the temporary permit on the windshield and went back inside to my place. Then just last night, I decided to walk outside to check on my car, and it was gone. I immediately knew what happened, called the tow company, and went to retrieve my car at about 2 a.m. They didnt charge me anything because they knew it was their mistake.

The guy who towed my car gave me some BS excuse about how they werent familiar with the temporary permit. The funny thing is, I had my moms 10 year old car up here for two weeks which also had a temporary permit, and that car magically never got towed. I feel like they try to prey on new cars because they need some way to make money and they bank on the chance that people wont get their permits right away. Even if theyre not familiar with the permit, I would hope these people at the minimum know how to read. Half of the fault should probably go to their equally incompetent partners, the Patrol Plus rentacops, who were most likely the ones who called in the tow company on my car. What a mess. Users/Anirudh

20090427 22:38:07 nbsp yeah fxxx these people. i agree w/ u anruidh Users/tahoeian

20090512 08:39:12 nbsp My car was towed in allegre at around 8pm, so I call them and the reception was courtliest and friendly.  When I got to the tow yard, the transaction was fast and professional.  Overall everyone was pretty friendly except for the driver with the Irish accent(didn’t sound or look friendly at all).  #220 is a lot of money but so is keeping the shop open 24/7 and have drivers on call….just don’t ever park your car there without a permit….not even for 10 minutes, IT WILL GET TOW!!! Users/acatmpf

20090606 14:37:13 nbsp My car was towed last night. The charge came out to $310. it would have been more if the guy working there had not told me about storage fees and what not. I was grateful that the service was good and quick, even if it cost $310 dollars!

On the plus side, they resister you once you get towed, so if they tow you again, they will call you.  Users/tmmeadow

20100211 17:24:28 nbsp Last I checked, a company presenting an authorization to tow a car from a complex under a general Authorization agreement with the complex CANNOT be an affiliate of the tow company that performs the service. This is outlined in California Vehicle Code 22658 linked at the top of the page.
What they do is the complex contracts out with Patrol Plus to authorize tows of invalid vehicles afterhours. By law, they need to make a written authorization to tow. In theory, Patrol Plus patrols the complexes they have contract with and calls in the tow when they find a violator. What actually happens (Per admittance of a tow operator) is that the tow company does the patrolling, finds a violator, and calls Patrol Plus to give them authorization to tow. I have caught them in the act doing it and they have openly admitted it before two other witnesses.
CVC 22658 is your best friend, learn it, know it, love it, it is written VERY specifically to protect you from abusive towing. Users/edwin.nielsen
  I dont see how it is abusive towing if there was a parking violation. The law seems to have just forced apartment complexes to hire a middleman that does not get paid on the number of cars towed. A better solution would be to let people whose cars get towed for ridiculous reasons take the towing company to court for a sum of money that provides compensation for lost wages and inconvenience. This way, complexes wont have to pay for a service that they really do not need if towing companies do the patrolling and only use Patrol Plus to get authorization. Getting rid of the middleman would not cause any problems if towers have to be able to prove that the car towed was in violation or else risk losing a large sum of money. The cost is probably passed onto renters as well. Just two cents from an advocate of the devil. Users/hankim

20100211 19:18:39 nbsp Abuse is because the intent of the law is that the landlord (or agent of) requests the tow. So, an advocate of the tenants (who pay to keep the place running and maintained) keeps unauthorized cars out. This should imply that an advocate for tenants should be able to notify the tenants if their car is being towed. Whereas an associate of the tow company would have no knowledge or access to such knowledge as to if it is a tenants car being towed or not. That is the purpose of that part of the law, and the exact kind of abuse taking place in Davis now with these two companies. The laws writing was to prevent the no permit  tow mentality of patrolling tow trucks, but now all they do is have a 3rd party authorizing it. edit: and how the hell do you do that bullet replay, anyway?Users/edwin.nielsen
  You just double click the text and edit. You need to put an asterisk before the text though. If the towing company were to call the agent of the apartment complex for authorization to tow a car, should the agent not inform the towing company if the car belongs to a resident or not if the apartment complex wanted tenant cars to be able to park without a permit? Apartment complexes do warn residents that cars without a parking permit will get towed. Because this is specifically stated in the parking lot, towing a car without a permit does not seem like abuse, even if the car belongs to a tenant. And if the cars of residents were kept from being towed even if the car is without a permit, this just opens up the parking lot to abuse by residents who decide to let their friends borrow their passes for a while, which in turn inconveniences others who are actually authorized to use the lot.  Users/hankim
   My impression is that the problem isnt that cars without permits get towed, but that a tow truck company is the one doing the patrolling.  Predatory towing is incredibly common and there have been several attempts in the state legislature to curtail it.  If I recall correctly, an illegal tow makes the tow company liable for something like 4x the bill.  The problem, unfortunately, is that you have to pay them to get your car back, even if they towed illegally.  If you dont pay it, they can sell your car after 30 days, apply the proceeds from the sale toward the bill you owe them (I think the legal limit is something like $70 or 80 per day in the lot, plus a couple hundred for the initial tow), and then send the remaining balance to collections.  Towing companies have a LOT of protection which makes it incredibly easy for them to abuse their power.  If you see one violating the law, you should absolutely report them.  If you personally get screwed by them, you should have a word with the CA Attorney Generals office, the BBB, and of course the DPD. Users/TomGarberson
    I know the problems that can arise from predatory towing. That is why I believe that wrongfully towing a car should have such a huge punishment that towing companies would think twice before doing something stupid. I just dont think that towing a car without a permit, especially if signs are everywhere, is predatory. Users/hankim

20100219 16:14:23 nbsp In response to Edwin,as an employee of All About Towing I resent the implication that anything was, or is done outside the guidelines of cvc 22658,in the course of our providing service to the complexes we service.We patrol disabled spaces, firelanes, entrances and exits, and yes resident only throughout the night so tenants that have a right to park in the spaces set appart for them, can. We are the best friend your car has if you properly display your parking permit your managment provided you.The intent of the legislation revising cvc 22658 was to insure the tow is authorized by the management or agent at the time tow, and that the price charged is accordance with all law enforcement towing and storage fees. Moreover,I  find it quite ironic that someone who is driving around on two year out of date, out of state license plates is commenting on california law. Sorry we met this way Users/KJONES

20100304 06:58:03 nbsp I HAVE 2 PAY ALMOST $8,000 TO GET MY CAR OUT! HOW IS THIS EVEN POSSIBLE!? DOES THE PREVIOUS OWNERS TICKETS STICK TO THE CAR AS WELL? THATS ALOT OF TICKETS! MIGHT AS WELL BUY A NEW FRIGGIN CAR BUT WOULD SOME1 MIGHT TRY N PUT ME INTO SOME TYPE OF DEBT IF I DONT? Users/reallyUpset

20100304 07:02:39 nbsp I ONLY WISH I CAN PAY A THREE DIGIT FEE 2 GET MY BABY BACK. I HAVE 2 PAY FOUR FIGURES! ARE THERE ANY TIPS ON PAYING LIKE REDUCING OR FINANCING OR PAYING IN INCREMENTS? THERES NO WAY I CAN PAY ALL THAT IN ONE LUMP SUM IN 72HRS DUE TO THE MARSHALLS SEIZING IT. THEY MAY PUT IT UP FOR SALE...sniffle Users/reallyUpset

20101015 14:14:12 nbsp Dear Edwin thanks a lot for posting your comments here. The problem is the weakness of CA law in regard of towing; unfortunately CA law does not apply much more restricted law about towing as some other states do. There are many technicality codes in state law that the judges in small claim court are not beware of, or not train for. Also since the counties collect business taxes from these companies it is much difficult to win your case in the court. Also plaintiff has a difficult time to challenge the judge. Personally I believe that the state should apply more restricted law for towing and increase the fine of illegal tow by at least 20x the bill. In this case 20X of the original bill would be $ 4400 which provides the plaintiff with better opportunities to spend money on attorney for consultation. As it is obvious in this page the company does lots of violations and fraud. In CA and most part of the USA we need a towing reform.    Users/joedavis

20110301 13:58:43 nbsp I think this is the towing company that patrols the Hoa Viet lot. If it is, back in late 2007 they definitively violated CVC 22658 (h), charging over $220 dollars when they hadnt even started to tow the car yet. CVC 22658 clearly states that they are not allowed to charge storage fees and are only allowed to charge half of the actual towing charge unless your vehicle has started transit. I later found out that their towing fee was only around $180, so legally all they could charge was $90 not the full $180 plus a $40 storage fee. This is a lesson, know the CVC 22658 before parking in this town. We parked the car in front of the restaurant while they were closed in the morning and were going to eat at the restaurant right when they opened for lunch. We arrived to the spot right before the restaurant opened to watch our car getting attached to a tow truck. Not sure if this was the restaurants fault or the tow truck companies fault, but they shouldnt be allowed to tow paying customers, and certainly not brake the law by violating CVC 22658 h. Users/MattHh

20110517 16:17:05 nbsp I was in an automobile accident on a busy overpass in Davis. Your driver, Mark, made a bad situation quite tolerable. He arrived at the scene within minutes and handled the situation with expertise.  He quickly got my truck out of the busy intersection and was concerned with my safety. He then went out of his way to explain my towing options. He was very professional, knowledgeable and careful towing my vehicle. My vehicle was towed out of town, so I was his passenger for a long haul. Mark made me feel totally at ease throughout the entire ordeal. I would highly recommend Mark for your towing needs.
 Users/DLP

20110523 01:38:16 nbsp If you are having automobile troubles, call these guys. My motorcycle and I got in a wreck last week and Mark was kind enough to tell me my options (pay now vs later, warning of storage fees at his lot, etc).  He was very understanding, and walked me through everything. He also only charged me for 30 minutes of labor instead of a full hour.

If your vehicle is towed because you parked where you werent supposed to, please understand that they are just doing their job. But if youre in trouble and need a tow, theyre professional, personable, and more than reasonable on price.   Users/CelesteIi

20110527 11:50:35 nbsp Employees were professional about the situation and friendly as well. Got me in and out in a matter of minutes, so service was quick. Only thing is I dont agree with one of the other comments above  On the plus side, they register you once you get towed, so if they tow you again, they will call you. false. This was my second towing from them and my car was just there for 2 days and I did not receive any notification. Had they called or notified me somehow, I would have really appreciated it since I would have saved money on the storage fees. But overall, they maintained their professionalism, were organized and friendly, and even apologized I hadnt been transferred to someone that could help me right away when I first called (the lady said to call back later when someone would be in the office). No damages done to my car either, so Im glad about their service in that respect. And just a note, they dont accept checks, so make sure you have cash or a credit/debit card on hand! Users/Anonymous222

20110807 13:56:59 nbsp I called All About Towing last night when my car died.  They were very friendly on the phone, and quoted me a price.  Mark, the tow guy, arrived very quickly and was extremely helpful.  He offered to try a jump first (which was a reduced cost), before towing.  The jump didnt work out, but Mark stuck to his original price quote, and did not add on any extra fees for jumping the car.  He is also full of stories and quite entertaining, making a lousy situation not feel so bad.  In the end, he also gave me a ride home.  Overall, I found this towing company to be fast, friendly, reliable and professional.  Of course, if you park somewhere where you are not allowed to park, you should probably expect that you will be paying for a tow.  That is just the way it works.  Read the signs. Users/BrookeRoberts

20110812 19:23:16 nbsp I needed my car towed and they were the only company that even cared to help ASAP. Great service, Mark offered to jump start my car so I wouldnt have to have it towed, in the end I needed it towed, but he charged me the same!! It was great, fast service and I really appreciate how nice and patient Mark was towards me!! Users/krisLeid

20110920 22:51:13 nbsp My car broke down and I called them. The man over the phone (I think his name was Kevin) was very friendly and had someone out to help me within 15 minutes. Mark, the person who helped me tow my car, was professional and helpful when it came to getting my car to the place I needed it to be! If I ever need to be towed in Davis again, Im calling them. Also, it was relatively cheap ($90) compared to some other tow jobs Ive heard about.  Users/Graveflower

20111219 21:48:10 nbsp This company was great. My car broke down Saturday afternoon and they were the only company open on the weekend. Service was prompt, and they gave me a discount because the trip was short.
Any and all negative reviews on here are just from people who are bitter that their cars got towed after they illegally parked (which is their own fault).
I definitely recommend All About Towing. Users/AnnabelVera

20120208 20:57:13 nbsp I actually had a great experience with All About Towing tonight. I needed a jump on my car & a driver by the name of Mark got to me within in 10
minutes of me calling & he was AWESOME! He helped me with my insurance to get the bill paid by State Farm & went beyond what he had to do to help me get going again. He didnt mess around. I would recommend them to everyone! Thank you Mark!  Users/Sherylb

20120220 23:17:53 nbsp I was in an accident today on 80 right outside of Davis.  CHP was involved and called All About Towing for me.  I was really glad they did.  Mark was there quickly, was friendly and helpful.  I was very appreciative of this being new to the area without and friends or family very close to help.  If I ever needed their services again I wouldnt hesitate to call them.
As for the remarks about avoiding this companies towing services, the only way to do that is to avoid parking illegally.  You dont get to choose who tows you if youre breaking the rules.  Deal with the consequences and stop complaining.   Users/MichelleS

20120226 01:35:46 nbsp Great experience with them.  My car broke down while driving on I80 eastbound, just before the Causeway, in a pretty dark place.  I called a couple of companies, one of which said it would take a couple of hours for them to arrive, and another which didnt even answer.  I finally called All About Towing, and they said they could help out right away.  The person that assisted me, Mark, was there within 20 minutes, and he drove from Vacaville.  He was patient while we waited for a friend to pick up others in my car and take them back to Davis.  We then went and dropped my car off at a repair shop in Davis, and even gave me a ride back home.  He even took care of the paperwork so this could be covered by my insurance company.  Overall it was a great relief to be helped out so fast by their staff and by someone nice and professional like Mark, who really went out of his way to help.  Dont hesitate to contact them first, and directly, if you run into any trouble! Users/MHess

20120423 07:58:32 nbsp My classic car, a 1981 DeLorean, had clutch problems after I over used the clutch in the UC Davis Picnic Day parade earlier in the day.  Kevin from All About Towing came out to give me a tow 50 miles back home.  Kevin was super friendly, very careful with the car, and even gave me a few minutes when we arrived home to wash off the clutch fluid while the car was still up on the truck bed.  If you find yourself stuck somewhere in Davis, these are the guys to call! Users/DavidProehl

20120515 16:32:17 nbsp A couple weeks ago, I needed a jump for my car battery. Within ten minutes, I was helped and within 15 everything was over :) Although the price was really high (it was average based on other companies I compared it to $65), Mark Wohlgemuth, the tow truck operator who came out to help us, was very knowledgeable and cordial. He taught me a few things about the battery and handled my situation very well.  Users/MariaKalola

20120630 15:54:24 nbsp Very good experience with this company and the driver, Mark Wohlgemuth. My car broke down on 80 outside of Dixon, and Mark showed up quickly, and at a cheaper rate than others had quoted me. He was very professional, friendly, and efficient and I am keeping his business card in my wallet in case I need a tow again (fingers crossed). I highly recommend giving him a call if you need towing services. Users/DavidMistchenko

20120814 21:55:55 nbsp Very good service!  The driver Mark was nice and towed my car safely, and he only took a half hour from the time I called to get to my apartment.  I received a discount so it only ended up being $45 to tow it across town, super cheap!  I highly recommend this company.   Users/JaclynGee

20121205 21:37:53 nbsp Great experience will All About Towing. Driver was Mark W. He was very friendly and professional and was extremely careful about my vehicle. Highly recommended. Users/AlanStevenson

20130531 11:08:10 nbsp Mark W. came to my aid quickly when I had a flat on the shoulder of 113 near the Covell turnoff. He changed the tire and met me at the 76 Station (safe and out of traffic) to fill out the paperwork. Mark was friendly, personable and extremely helpful. Also if you have State Farm roadside coverage, they will bill State Farm! Users/jdevine

20130813 10:19:29 nbsp Mark was a life saver. My car broke down on the entry of the causeway coming from Sacramento, CHP was a total jerk Mark made up for it by coming to the rescue quickly. He was comforting and even though CHP made my anxiety go through the roof his friendly demenior and laid back attitude calmed me down. I would definitely recommend using them, if you break down in the Davis area. Users/Brendenstapp

20130906 16:59:36 nbsp I own a business and moved locations and 12 cars was wrogfully towed from my parking lot went to court and tow yard sued me for money and i won but tow yard refuses to return cars what is my next action need help Users/Glenmattis

  Glen, I am a little confused about your posting.  I have a few questions.  First, what city and state are you located in?   Second, in California, to lawfully tow a vehicle from a parking lot, the owner of the property, their representative or a tenant in control of the property must request the tow and then sign for having the vehicle towed.  Do you own, manage or rent the property?    Third, when an unauthorized vehicle is towed and stored from private property, the towing company will bill the registered owner of the vehicle for the fees.    Fourth, do you own the cars?  If not, why would the towing company return the vehicles to you and not the registered owners?  Fifth, have you contacted your local law enforcement agency?  They may be able to help you.  If you have further questions, feel free to call us at 5302973200. Users/RandyRoss

20140127 08:30:27 nbsp My tire got shredded on the freeway, I called for assistance and Mark responded very quickly. He put on the spare and then we moved to a safe location to complete paperwork. Mark was very professional and concerned with my safety. He was knowledgeable and recommended a place nearby to get my tire replaced. It was a great experience. Users/reneemcsweeney

20140129 13:31:04 nbsp Great company!  They proved to be true to their logo, Fast, Friendly Service.  I was having one of THOSE mornings this morning!  You know the kind?! The kind of morning when you are already late for work, and then you go and lock your keys in your car!!  It was not until I safely dropped my daughter off at school that I realized on my walk back to my car that I did not have my keys!  Much to my dismay, I quickly realized that I had locked them in my car by accident in my rush!  Luckily I still had my cell phone in my pocket so I could call my insurance company. Well, my insurance company told me it would be 2 hours before they could get someone out to help me!  I could not wait 2 hours, so I goggled roadside assistance davis ca and All About Towing came up.  I called them and they assured me that they could indeed help retrieve my keys out of my locked car!  They charged a small fee to do so, but well worth it!  Mark arrived to help me within 10 minutes, with a friendly demeanor, and had me on my way back to work a.s.a.p.!  I would definitely recommend this company to help you with any roadside assistance you may need! Users/Shaninis

20140302 20:50:08 nbsp First of all I would like to say that Mark provided a very fast, friendly service.  I locked my keys in the car, I called my road side service and I was informed that it was going to take 45 minutes.  I gave them my address.  Marked called me shortly to confirm my address, he asked me if I was in a safe spot and I told him that I was but I was cold and my keys were locked in the car.  He told me not to worry and that he would make it ASAP.  He actually  made it within 15 minutes, instead of the original 45 that my road side service said.  He was not creepy or annoying at all.  He was very respectful, friendly, and provided great service.  I would highly recommend Mark to anyone.   Users/almaerojas

20140325 14:41:36 nbsp My experience with All About Towing was nothing but positive! After having to deal with a dead car followed by useless roadside assistance, I called All About Towing to help get my car to the nearest repair shop. Mark Wohlgemuth showed up at my apartment complex at his earliest convenience and was immediately helpful and friendly. He talked to my insurance company so that I wouldnt have to pay for the second assistance call outofpocket, was kind enough to give my car a jump and assess the battery and alternator, and even followed me to the repair shop to make sure that my car made it there without any issues. Mark was extremely understanding of my situation and made the whole ordeal much less stressful overall. I definitely know who Ill be calling if I run into any more car problems in the future. Thank you!! Users/nicmik

20140523 17:22:38 nbsp I ran out of gas today on the freeway in Davis like a knucklehead.  I thought I could make it, but I didnt.  Anyways, used google and found All About Towing and gave them a call.  I got a response to my location in less than ten minutes!  Very nice!  Mark gave me gas, directed me to the next exit and finished up my payment in a safe location off the freeway.  All in all, Mark saved my ass today...thank you brother.

I must say, I was pretty alarmed to see all the knucklehead posts above whining about towing and storage fees.  Im not that old, but the entitlement exhibited makes me Lee Trevino.  Hey kids...park legally, immediately pick your car up if you get towed and thank your mom and dad for paying for your tuition, room, board, car, tow fees, etc... Users/DaveReece

20140731 12:42:11 nbsp Mark is the best! He got to my car in about 10 minutes after I called which really saved me some nerves while I was freaking out on the parking lot wondering what is that smoke coming off my car! I really appreciate that he wasnt only professional, but also super friendly, which is very important in such stressful situation. On the way to the repair shop, Mark gave me a lot of good advises about  local car services and how to take care of my car, which I thought is really nice since I just moved here and dont know anyone. Thank you Mark! I highly recommend All about towing to everyone!  Users/IrinaKoryakina