tlf_exp Subroutine

  subroutine tlf_exp(ov,itype,i1,i2,s_mo,precomp,noca,nbf)

    use precision, only: dp
    implicit none

    real(kind=dp) :: ov, precomp
    integer :: i1, i2, itype, nbf, noca
    real(kind=dp), dimension(nbf,nbf) :: s_mo

    real(kind=dp) :: ov1, ov2
    integer :: ia1, ia2, l, lp

!   itype=11 : alpha 1st order
!   itype=21 : beta  1st order
!   itype=12 : alpha 2nd order
!   itype=22 : beta  2nd order

    select case (itype)
    case (11)
       ov = precomp*s_mo(i2,i1)/(s_mo(i1,i1)*s_mo(i2,i2))
       return

    case (21)
       ia1 = i1
       ia2 = i2
       ov = precomp*s_mo(ia1,ia2)
       return

    case (12)
       if (i1/=i2) then
          ov = 0.0_dp
          do l = 1, noca
            if (l/=i1 .and. l/=i2) then
               ov = ov+s_mo(i2,l)*s_mo(l,i1)/s_mo(l,l)
            end if
          end do
          ov = -1.0_dp*precomp*ov/(s_mo(i1,i1)*s_mo(i2,i2))
          return
       else
          ov = 0.0_dp
          do l = 1, noca-1
            if (l/=i1) then
              do lp = l+1, noca
                if (lp/=i1) then
                  ov = ov+s_mo(l,lp)*s_mo(lp,l)/(s_mo(l,l)*s_mo(lp,lp))
                end if
              end do
            end if
          end do
          ov = -1.0_dp*precomp*ov/s_mo(i1,i1)
          return
       end if

    case (22)
       ia1 = i1
       ia2 = i2
       if (ia1/=ia2) then
          ov = 0.0_dp
          do l = 1, noca-2
             ov = ov+s_mo(ia1,l)*s_mo(l,ia2)/s_mo(l,l)
          end do
          ov = -1.0_dp*precomp*ov
          return
       else
          ov1 = 0.d+00
          do l = 1, noca-2
             ov1 = ov1+s_mo(ia1,l)*s_mo(l,ia2)/s_mo(l,l)
          end do
          ov2 = 0.0_dp
          do l = 1, noca-3
            do lp = l+1, noca-2
               ov2 = ov2+s_mo(l,lp)*s_mo(lp,l)/(s_mo(l,l)*s_mo(lp,lp))
            end do
          end do
          ov2 = ov2*s_mo(ia1,ia1)
          ov = -1.0_dp*precomp*(ov1+ov2)
          return
       end if

    case default
       error stop "Unknown itype for tlf_exp"

    end select

  end subroutine tlf_exp