C     ******************************************************************
C     ******************************************************************

      subroutine unini(n,l,u,m,lambda,rho,equatn,linear,inform)

      implicit none

C     SCALAR ARGUMENTS
      integer inform,m,n

C     ARRAY ARGUMENTS
      logical equatn(m),linear(m)
      double precision l(n),lambda(m),rho(m),u(n)

C     PARAMETERS
      include "dim.f"

C     COMMON SCALARS
      logical under
      character * 5 utype

C     COMMON ARRAYS
      integer nsub(nmax)
      double precision alpha(nmax,nsubmax),beta(nmax,nsubmax),
     +        gamma(nmax,nsubmax),y(2*nmax)

C     LOCAL SCALARS
      logical overflow
      integer i,j,ns
      double precision tmp,yl,ys,yu

C     LOCAL ARRAYS
      integer sub(nmax)
      double precision atmp(nmax),H(2*nmax**2),ytmp(2*nmax)

C     COMMON BLOCKS
      common /undata/ alpha,beta,gamma,y,nsub,under,utype

C     EXTERNAL FUNCTIONS
      integer P
      double precision iinf,isup

C     SET PROBLEM TYPE AS "UNDERESTIMATOR"
      under = .true.

C     SET BOUNDS IN INTERVAL STYLE
      do i = 1,n
          call ivl2(l(i),u(i),y(P(i)))
      end do

C     PLAIN alpha-BB
      if ( utype .eq. 'PLAIN' ) then

C         COMPUTE INTERVALAR HESSIAN
          call evalhali(n,y,m,lambda,rho,equatn,linear,H,inform)
          if ( inform .lt. 0 ) then
              return
          end if

C         COMPUTE ALPHA USING SCALED GERSCHGORIN
          call sgersch(n,y,H,atmp)

          do i = 1,n
              alpha(i,1) = atmp(i)
          end do

C     PIECEWISE alphaBB
      else ! if ( utype .eq. 'PWISE' ) then

          do i = 1,n
              nsub(i) = 2

              yl = iinf(y(P(i)))
              yu = isup(y(P(i)))
              if ( yu - yl .le. 1.0d-08 ) then
                  nsub(i) = 1
              end if
          end do

          do i = 1,n
              do j = 1,nsub(i)
                  alpha(i,j) = - 1.0d+99
              end do
          end do

          overflow = .false.

          call iniv(n,sub)
          do i = 1,n
              yl = iinf(y(P(i)))
              yu = isup(y(P(i)))
              ys = ( yu - yl ) / nsub(i)

              ytmp(2*i-1) = yl + ( sub(i) - 1 ) * ys
              ytmp(2*i  ) = yl +   sub(i)       * ys
          end do

 10       if ( .not. overflow ) then

C             COMPUTE INTERVALAR HESSIAN
              call evalhali(n,ytmp,m,lambda,rho,equatn,linear,H,inform)
              if ( inform .lt. 0 ) then
                  return
              end if

C             COMPUTE ALPHA (FOR A SUBDOMAIN) USING SCALED GERSCHGORIN
              call sgersch(n,ytmp,H,atmp)

C             FOR THE SLICE TAKE THE MAXIMUM OVER ALL THE SUBDOMAINS
              do i = 1,n
                  alpha(i,sub(i)) = max( alpha(i,sub(i)), atmp(i) )
              end do

C             SET NEXT SUBDOMAIN
              call incrv(n,sub,nsub,overflow)
              do i = 1,n
                  yl = iinf(y(P(i)))
                  yu = isup(y(P(i)))
                  ys = ( yu - yl ) / nsub(i)

                  ytmp(2*i-1) = yl + ( sub(i) - 1 ) * ys
                  ytmp(2*i  ) = yl +   sub(i)       * ys
              end do

              go to 10

          end if

C         COMPUTE BETA AND GAMMA
          do i = 1,n
              yl = iinf(y(P(i)))
              yu = isup(y(P(i)))
              ys = ( yu - yl ) / nsub(i)
              ns = nsub(i)

              beta(i,1) = 0.0d0
              do j = 2,ns
                  beta(i,1) = beta(i,1) + 
     +            ( ns - j + 1 ) * ( alpha(i,j-1) + alpha(i,j) )
              end do
              beta(i,1)  = ys * beta(i,1) / ns
              gamma(i,1) = - beta(i,1) * yl

              do j = 2,ns
                  tmp        = ys * ( alpha(i,j-1) + alpha(i,j) )
                  beta(i,j)  = beta(i,j-1) - tmp
                  gamma(i,j) = gamma(i,j-1) + 
     +                         ( yl + ( j - 1 ) * ys ) * tmp 
              end do
          end do

      end if

      end

C     ******************************************************************
C     ******************************************************************

      subroutine sgersch(n,y,H,alpha)

C     SCALAR ARGUMENTS
      integer n

C     ARRAY ARGUMENTS
      double precision alpha(n),H(2*n**2),y(2*n)

C     This subroutine computes, using the Scaled Gerschgorin Theorem,
C     values alpha_i, i = 1, ..., n such that for all H in [H] 
C
C                 H + 2 diag(alpha_1, ..., alpha_n)
C
C     is a semi-positive definite matrix.

C     PARAMETERS
      include "dim.f"

C     LOCAL SCALARS
      integer i,ind,j
      double precision elemod

c     LOCAL ARRAYS
      double precision d(nmax)

C     EXTERNAL FUNCTIONS
      integer P,P2
      double precision iinf,isup

      do j = 1,n
          d(j) = max( 1.0d-08, isup(y(P(j))) - iinf(y(P(j))) )
      end do

      do j = 1,n
C         Diagonal element  (j,j)
          ind = P2(j,j,n)
          alpha(j) = iinf(H(ind))
      end do

      do j = 1,n
          do i = j + 1,n
C             Off-diagonal elements (i,j) and (j,i)
              ind = P2(i,j,n)
              elemod = max(abs(iinf(H(ind))),abs(isup(H(ind))))
              alpha(i) = alpha(i) - elemod * d(j) / d(i)
              alpha(j) = alpha(j) - elemod * d(i) / d(j)
          end do
      end do

      do j = 1,n
          alpha(j) = max( 0.0d0, - 0.5d0 * alpha(j) )
      end do

      end

C     ******************************************************************
C     ******************************************************************

      integer function P(i)

C     SCALAR ARGUMENTS
      integer i

      P = 2 * i - 1

      return

      end

C     ******************************************************************
C     ******************************************************************

      integer function P2(i,j,n)

C     SCALAR ARGUMENTS
      integer i,j,n

      P2 = 2 * n * (j - 1) + 2 * i - 1

      return

      end

C     *****************************************************************
C     *****************************************************************

      subroutine iniv(n,ind)

C     SCALAR ARGUMENTS
      integer n

C     ARRAY ARGUMENTS
      integer ind(n)

C     LOCAL SCALARS
      integer i

      do i = 1,n
          ind(i) = 1
      end do

      end

C     *****************************************************************
C     *****************************************************************

      subroutine incrv(n,ind,lastind,overflow)

C     SCALAR ARGUMENTS
      integer n
      logical overflow

C     ARRAY ARGUMENTS
      integer ind(n),lastind(n)

C     LOCAL SCALARS
      integer i

      i = n

 10   if ( i .gt. 0 .and. ind(i) .eq. lastind(i) ) then
          ind(i) = 1
          i = i - 1
          go to 10
      end if

      if ( i .gt. 0 ) then
          ind(i) = ind(i) + 1
          overflow = .false.
      else
          overflow = .true.
      end if

      return

      end