      program simplex_node
      implicit none

      include '/usr/include/fcube.h'
      include 'simcubeb.h'
      include 'simnodeb.h'
   
c---------------------------------------------------------------------------
c   
c  This code perfomes the simplex method to solve
c  linear programming problems on hypercube iPSC/2
c  The matrix A is distributed by row to each node
c  and the coefficient of objective is distributed by scatter partition
c 
c  This is a node program
c
c version date: 4/16/1991
c
c-------------------------------------------------------------------------

c  local variables
c
      integer i, j, k

      thisNode = mynode()
      hostNode = myhost()
      numNode = numnodes()
      numDim = nodeDim()
      iteration = 0

      call initial
c
c  code for node 0
c
      if (thisNode .eq. 0) then
        if (numGE .eq. 0) then
          print *, ' There is no phase I'
         else
          print *, ' Starting phase I....'
        end if
        timeBegin = mclock()
      end if
c
c  code for the last row
c
      if (kLastRow) then
        print *, 'w = ', x(numEqu-minRow+2)
      end if
c
c  code for all node
c
      if ( numGE .ne. 0 ) then
        colMax = numvarI
        call simplex(1)
      end if
c
c  code for the last row
c
      if (kLastRow) then
        print *, 'w = ', x(numEqu-minRow+2)
      end if
c
c  code for node 0
c
      if ((numGE .ne. 0) .and. (thisNode .eq. 0)) then
        if ( .not. bounded) then
          print *, ' It is not bounded'
        end if
        if (cont) then
          print *, ' Phase I was not successful, please killcube'
         else
          print *, ' Phase I was successful'
        end if
      end if
c
c  code for node 0
c
      if (thisNode .eq. 0) then
        print *, ' Starting phase II'
      end if
c
c  redistribution coefficient matrx a in phase II
c
      if (numGE .ne. 0) then
        minCol = allColRow(3, thisNode+1)
        numCol = allColRow(4, thisNode+1)
        k = minCol
        do j = 1, numCol
          row_node(j) = row1(k)
          k = k + numNode
        end do
      end if
c
c code for all node
c
      colMax = numvarII
      call simplex(2)
c
c  code for node 0
c
      if (thisNode .eq. 0) then
        timeEnd = mclock()
        if (bounded) then
          print *, ' Phase II was successful'
         else
          print *, ' Phase II was not successful, plsase killcube'
          print *, ' Variable', pivotCol, ' is not bounded'
        end if
        print *, ' Elapsed time: ', timeEnd-timeBegin
      end if
c
c  code for the last row
c
      if (kLastRow) then
        print *, ' At node, Min =', x(numEqu-minRow+1)
        call csend(gtype,x(numEqu-minRow+1),doubleSize,hostNode,NPID)
        print *, ' It takes ', iteration, ' iterations'
      end if
c
c  code for node 0
c
      if (thisNode .eq. 0) then
        call csend(gtype, x(1), doubleSize, hostNode,npid)
      end if

      stop
      end

c-----------------------------------------------------------------

      subroutine initial
      implicit none

      include 'simcubeb.h'
      include 'simnodeb.h'
c
c  local variables
c
      integer i, j, k

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c  receiving info numVar, numEqu, numCon, numG, numE, numL
c
      call crecv(gtype, info, 6*intSize)

      numVar = info(1)
      numEqu = info(2)
      numCon = info(3)
      numG = info(4)
      numE = info(5)
      numL = info(6)
      numGL = numG + numL
      numGE = numG + numE
      numVarI = numVar + numGE + numGL
      numVarII = numVar + numGL
c
c  receiving allColRow 
c
      call crecv(gtype-1,allColRow,6*numNode*intSize)
      minCol = allColRow(1, thisNode+1)
      numCol = allColRow(2, thisNode+1)
      minRow = allColRow(5, thisNode+1)
      maxRow = allColRow(6, thisNode+1)
      numRow = maxRow - minRow + 1
      kLastRow = maxRow .ge. (numEqu-1)
c
c  receiving the right hand side x
c
      call crecv(gtype-2, realBuf, (numEqu+1)*doubleSize)
      k = minRow
      do i = 1, numRow+2
        x(i) = realBuf(k)
        k = k + 1
      end do
c
c  receiving the last tow rows, row1 and row2
c
      call crecv(gtype-3,row1,numVarI*doubleSize)
      call crecv(gtype-4,realBuf,numVarI*doubleSize)
      k = minCol
      do j = 1, numCol
        row_node(j) = realBuf(k)
        k = k + numNode
      end do
c
c  receiving coefficient matrix a at node
c
      do i = 1, numRow
        call crecv(gtype+1,realBuf,numVarI*doubleSize)
        do j = 1, numVarI
          a(i, j) = realBuf(j)
        end do
      end do
c
c  code for all node
c
      do j = 1, numVarI
         nonbasic(j) = .true.
      end do
      do i = numVar+numG+1, numVarII
         basic(i-numVar+numE) = i
         nonbasic(i) = .false.
      end do 
      do i = numVarII+1, numVarI
        basic(i-numVarII) = i
        nonbasic(i) = .false.
      end do

      return
      end

c-----------------------------------------------------------------

      subroutine simplex(phase)
      implicit none

      include 'simcubeb.h'
      include 'simnodeb.h'
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      call next(phase)
      do while (cont .and. bounded)
         call trans(phase)
         call next(phase)
      end do

      return
      end

c------------------------------------------------------------------
      subroutine next(phase)
      implicit none
 
      include 'simcubeb.h'
      include 'simnodeb.h'
c
c  local variables
c
      double precision large, small
      parameter (large = 1.0d+7)
      parameter (small = 1.0d-7)

      double precision val, sum
      integer i, j, k
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c   Find the leaving column
c
c  code for all nodes
c
      pivotCol = -1
      maxval = -large
      do j = 1, numCol
        if (nonbasic((j-1)*numNode+thisNode+1)) then
          if ((row_node(j) .gt. maxval) .or.
     *                        (pivotCol .eq. -1)) then
            maxval = row_node(j)
            pivotCol = j
          end if
        end if 
      end do
c
c  reduct on maxval over all nodes to get one pivotCol and maxval
c
      realBuf(1) = maxval
      realBuf(2) = (pivotCol -1)*numNode + thisNode + 1
      call GOPF(realBuf, 2*doubleSize, work2, MaxReduct)
      maxval = realBuf(1)
      pivotCol = realBuf(2)

      cont = (maxval .gt. small)
c
c  pivot column is in this node
c
      kIndxCol = (MOD(pivotCol-1, numNode) .eq. thisNode)

      if (cont) then
c
c  check if this column is bounded
c
        bounded = .false.
        do i = 1, numRow
          if ((.not. bounded) .and. (a(i, pivotCol) .gt. small)) then
            bounded = .true.
          end if
        end do
        call GLOR(bounded, 1, worklogical)
c
c  find the pivot row
c
        minval = large
        if (bounded) then
          do i = 1, numRow
            if (a(i, pivotCol) .gt. small) then
              val = x(i)/a(i, pivotCol)
              if (val .lt. minval) then
                minval = val
                pivotRow = i
              end if
            end if
          end do
          realBuf(1) = minval
          realBuf(2) = pivotRow + minRow - 1
          call GOPF(realBuf, 2*doubleSize, work2, MinReduct)
          minval = realBuf(1)
          pivotRow = realBuf(2)

          kIndxRow = (pivotRow .ge. minRow) .and. (pivotRow .le. maxRow)

c
c   pivot row is in this node, that row 
c   to send to all nodes
c
          if (kIndxRow) then
            k = pivotRow - minRow + 1
            do j = 1, colMax
              realBuf(j) = a(k, j)
            end do
            if (numNode .gt. 1) then
              call csend(stype+3*iteration+1,realBuf,
     *                  colMax*doubleSize,allNode,npid)
            end if
           else
            call crecv(stype+3*iteration+1,realBuf,
     *                colMax*doubleSize)
          end if
c
c  code for all node
c
          nonbasic(basic(pivotRow)) = .true.
          basic(pivotRow) = pivotCol
          nonbasic(pivotCol) = .false.

        end if       
      end if

      return
      end

c-------------------------------------------------------------------

      subroutine trans(phase)
      implicit none

      include 'simcubeb.h'
      include 'simnodeb.h'
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c
c  local variables
c
      integer i, j, k
      double precision factor
c
c  code for all nodes
c
      pivot = realBuf(pivotCol)
      do j = 1, colMax
        realBuf(j) = realBuf(j)/pivot
      end do
c
c  code for all nodes
c
      do i = 1, numRow
        col(i) = a(i, pivotCol)
      end do
      do i = 1, numRow
        x(i) = x(i) - col(i)*minval
        do j = 1, colMax 
          a(i, j) = a(i, j) - col(i)*realBuf(j)
        end do
      end do
c
c  code for pivot row
c
      if (kIndxRow) then
        k = pivotRow - minRow + 1
        x(k) = minval
        do j = 1, colMax
          a(k, j) = realBuf(j)
        end do
      end if
c
c  code for all nodes
c
      if (phase .eq. 1) then
        factor = row1(pivotCol)
        do j = 1, colMax
          row1(j) = row1(j) - factor*realBuf(j)
        end do
      end if
      do j = 1, numCol
        row_node(j) = row_node(j)
     *            - maxval*realBuf((j-1)*numNode+thisNode+1)
      end do
c
c  code for the last node
c
      if (kLastRow) then
        if (phase .eq. 1) then
          x(numEqu-minRow+1) = x(numEqu-minRow+1) - factor*minval
          x(numEqu-minRow+2) = x(numEqu-minRow+2) - maxval*minval
         else
          x(numEqu-minrow+1) = x(numEqu-minRow+1) - maxval*minval
        end if
      end if

      iteration = iteration + 1

      return
      end

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C			MaxReduct				C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
        subroutine MaxReduct(mine, work)
        implicit none

        double precision mine(2), work(2)

        if ((mine(2) .LT. 0.0) .or. ((work(2) .gt. 0.0) .and. 
     &	     ((mine(1) .LT. work(1)) .or. ((mine(1) .eq. work(1))
     &      .and. (mine(2) .GT. work(2)))))) then
          mine(1) = work(1)
          mine(2) = work(2)
        end if
        return
        end

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C			MinReduct				C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
        subroutine MinReduct(mine, work)
        implicit none

        double precision mine(2), work(2)

        if ((mine(2) .LT. 0.0) .or. ((work(2) .gt. 0.0) .and. 
     &	    ((mine(1) .GT. work(1)) .OR. ((mine(1) .eq. work(1))
     &      .AND. (mine(2) .GT. work(2)))))) then
          mine(1) = work(1)
          mine(2) = work(2)
        end if
        return
        end

