      program revised_host
      implicit none

      include '/usr/include/fcube.h'
      include 'revcube.h'
      include 'revhost.h'
   
c---------------------------------------------------------------------------
c   
c  This code perfomes the revised simplex method to solve
c  linear programming problems on hypercube iPSC/2
c  The matrix is using block partition, and the matrix A is
c  distributed by using scatter partition
c 
c  This is a host program
c
c version date: 4/24/1991
c
c-------------------------------------------------------------------------
c
c  local variables
c
      integer i, j, k, jj

      print *, ' REVISED SIMPLEX METHOD FOR LINEAR PROGRAMMING '
      print *, ' ON HYPERCUBE iPSC/2'
      print *, ' '

      print *, ' Loading programs into node...'
      call setpid(NPID)
      call load('revcode', ALLNODE, NPID)

      numNode = numnodes()
      numDim = nodedim()

      call getdata 
c      call gettemdata 

      info(1) = numVar
      info(2) = numEqu
      info(3) = numEqu-1
      info(4) = numG
      info(5) = numE
      info(6) = numL
c
c  distribution on each node
c
      nodeRow = (numEqu-1)/numNode
      if (mod((numEqu-1), numNode) .ne. 0) then
        nodeRow = nodeRow + 1
      end if
      do k = 0, numNode-1
        minRow = k*nodeRow + 1
        maxRow = minRow + nodeRow - 1
        if (minRow .gt. (numEqu-1)) then
          minRow = numEqu - 1
          maxRow = numEqu - 2
         else if (maxRow .gt. (numEqu-1)) then
          maxRow = numEqu - 1
        end if
        allColRow(3, k+1) = minRow
        allColRow(4, k+1) = maxRow
      end do 
c
c  matrix A is distributed by using scatter partition
c
      nodeCol = (numVar+numGE+numGL)/numNode
      k = MOD((numVar+numGL+numGE), numNode)
      do i = 1, k
        allColRow(1, i) = i
        allColRow(2, i) = nodeCol + 1
      end do
      do i = k+1, numNode
        allColRow(1, i) = i
        allColRow(2, i) = nodeCol
      end do
      nodeCol2 = (numVar+numGL)/numNode
      k = MOD((numVar+numGL), numNode)
      do i = 1, k
        allColRow(5, i) = i
        allColRow(6, i) = nodeCol2 + 1
      end do
      do i = k+1, numNode
        allColRow(5, i) = i
        allColRow(6, i) = nodeCol2
      end do
      

      print *, ' Number of variables ', numVar
      print *, ' Number of equations', numEqu
      print *, ' (G E L)', numG, numE, numL
      print *, ' Host is sending infomation, please wait...'

c
c  sending info numVar, numEqu, numCon, numG, numE, numL
c
      call csend(gtype+0, info, 6*intSize, ALLNODE, NPID)
c
c  sending allColRow 
c
      call csend(gtype-1,allColRow,6*numNode*intSize,ALLNODE,NPID)
c
c  sending right hand side x
c    
      call csend(gtype-2,x,(numEqu+1)*doubleSize,ALLNODE,NPID)
c
c  sending the last two rows of the coefficient matrix
c
      k = numVar + numGL + numGE
      call csend(gtype-3,row1,k*doubleSize,allNode,Npid)
      do i = 1, k
        realBuf(i) = a(numEqu+1, i)
      end do
      call csend(gtype-4,realBuf,k*doubleSize,allNode,Npid)
c
c  sending coefficient matrix a to each node (scatter partition)
c
      do k = 0, numNode-1
        minCol = allColRow(1, k+1)
        numCol = allColRow(2, k+1)
        do i = 1, numEqu-1
          jj = minCol
          do j = 1, numCol
            realBuf(j) = a(i, jj)
            jj = jj + numNode
          end do
          call csend(gtype+1,realBuf,numCol*doubleSize,k,NPID)
        end do
      end do 
c
c  receiving result from nodes
c
      call crecv(-1, minimal, doubleSize)
      print *, ' At host min = ', minimal
      call crecv(-1, minimal, doubleSize)
c
c  kill cube
c
      call killcube(ALLNODE, NPID)

      stop
      end

      subroutine GetTemData
      implicit none

      include 'revcube.h'
      include 'revhost.h'

      integer i, j
      numVar = 2
      numEqu = 4
      numG = 2
      numE = 0
      numL = 1
      numGE = 2
      numGL = 3
      do i = 1, 5
        do j = 1, 7
          a(i, j) = 0.0
        end do
      end do
      a(1, 1) = 3.0
      a(1, 2) = 4.0
      a(1, 3) = -1.0
      a(1, 6) = 1.0
      a(2, 1) = 3.0
      a(2, 2) = 1.0
      a(2, 4) = -1.0
      a(2, 7) = 1.0
      a(3, 1) = 1.0
      a(3, 2) = 1.0
      a(3, 5) = 1.0
      x(1) = 19.0
      x(2) = 7.0
      x(3) = 15.0
      x(5) = 26.0
      row1(1) = -10.0
      row1(2) = -5.0
      a(5, 6) = -1.0
      a(5, 7) = -1.0
      
      return
      end

C-----------------------------------------------------------------
C
C  Version Dated:  April 14, 1991
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C			GetData					C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

	subroutine GetData
	implicit none

        include 'revcube.h'
        include 'revhost.h'

c
c  input data with MPS format from netlib
c
c  output:  numG, numE, numL --- # of constrants with >=, =, <=
c           numEqu, numVar -- # of constrants, # of variable
c           a -- coefficient matrix
c           x -- right hand side
c
c
c   local variables
c
	character*8 rowLab(nn)
	integer SearchRow, count, i, j, k, ii
	character*4 tmpConstant
	character*8 nameStr, tmp1Lab, tmp3Lab, tmp4Lab, tmpLab
	character*1 rowType(nn)
	real*8 tmp1Data, tmp2Data, sum
	
	READ(*,'(A4 T15 A8)') tmpConstant, nameStr
	if (tmpConstant .NE. 'NAME') then
	    print *, 'Input format error, missing name field'
	    stop
	endif
        print *, ' The test data file is ', nameStr
	READ(*,'(A4)') tmpConstant
	if (tmpConstant .NE. 'ROWS') then
	    print *, 'Input format error, missing ROWS field'
	    stop
	endif
	do i = 1, m
	    READ(*,'(A4 T2 A1 T5 A8)') tmpConstant, rowType(i), rowLab(i)
	    if (tmpConstant .EQ. 'COLU') then
		numEqu = i - 1
	        goto 10
	    endif
	end do
	if (tmpConstant .NE. 'COLU') then
	    print *, 'Error: too many rows'
	    stop
	endif
10      continue
	numG = 0
	numE = 0
	numL = 0
C
C  Looking for the row with row type N, and exchange it with the last row
C
        do i = 1, numEqu
           if (rowType(i) .EQ. 'N') then
              call Exchange(rowType, rowLab, i, numEqu)
              goto 20
           end if
        end do
20      continue
C
C  Rearrange the rows according to the order of row type G, E, L
C
	i = 1
	j = numEqu-1
	do ii = 1, numEqu-1
	   do k = i, numEqu-1
	      if (rowType(k) .NE. 'G') then
	         i = k
                 goto 30
	      endif
	   end do
30        continue
	  do k = j, 1, -1
	     if (rowType(k) .EQ. 'G') then
		j = k
		goto 40
	     endif
	  end do
40        continue
	  if (i .GT. j) then
             goto 50
	  else 
	     call Exchange(rowType,rowLab,i,j)
	  endif
	end do
50      continue

	i = 1
	j = numEqu-1
	do ii = 1, numEqu-1
	  do k = i, numEqu-1
	     if ((rowType(k) .NE. 'E') .AND. (rowType(k) .NE. 'G')) then
		i = k
		goto 60
	     endif
	  end do
60        continue
	  do k = j, 1, -1
	     if (rowType(k) .NE. 'L') then
		j = k
		goto 70
	     endif
	  end do
70        continue
	  if (i .GT. j) then
             goto 80
	  else 
	     call Exchange(rowType,rowLab,i,j)
	  endif
	end do
80      continue
	do k = 1, numEqu-1
	  if (rowType(k) .EQ. 'G') then
	    numG = numG + 1
	  else
	    if (rowType(k) .EQ. 'E') then
	      numE = numE + 1
	    else
	      if (rowType(k) .EQ. 'L') then
		numL = numL + 1
	      endif
	    endif
	  endif
	end do

        do i = 1, numEqu+1
           x(i) = 0.0
           do j = 1, n
              a(i, j) = 0.0
           end do
        end do
        Count = 0
        numVar = 1
        do i = 1, nn
           READ(*, '(A3 T5 A8 T15 A8 T25 F12.3 T40 A8 T50 F12.3)')
     &            tmpConstant, tmp1Lab, tmp3Lab, tmp1Data,
     &            tmp4Lab, tmp2Data
 
           if (Count .EQ. 0) tmpLab = tmp1Lab
           Count = Count + 1
           if (tmpConstant .EQ. 'RHS') then
              goto 90
            else
              if (tmp1Lab .NE. tmpLab) then
                 tmpLab = tmp1Lab
                 numVar = numVar + 1
              end if
              k = SearchRow(tmp3Lab, rowLab, numEqu)
              a(k, numVar) = tmp1Data
              if (tmp4Lab .NE. '        ') then
                 k = SearchRow(tmp4Lab, rowLab, numEqu)
                 a(k, numVar) = tmp2Data
              end if
           endif
        end do

        if (tmpConstant .NE. 'RHS') then
           print *, 'Error:  too many columns'
           stop
        end if

90      continue
        do i = 1, nn
           READ(*, '(A4 T5 A8 T15 A8 T25 F12.3 T40 A8 T50 F12.3)')
     &            tmpConstant, tmp1Lab, tmp3Lab, tmp1Data,
     &            tmp4Lab, tmp2Data

           if (tmpConstant .EQ. 'ENDA') then
              goto 100
            else
              k = SearchRow(tmp3Lab, rowLab, numEqu)
              x(k) = tmp1Data
              if (tmp4Lab .NE. '        ') then
                 k = SearchRow(tmp4Lab, rowLab, numEqu)
                 x(k) = tmp2Data
              end if
           endif
        end do

        if (tmpConstant .NE. 'ENDA') then
           print *, 'Error:  too many RHS'
           stop
        end if
100     continue
c
c  set up the coefficient for slack and artifical variables
c  and right hand side
c
        numGE = numG + numE
        numGL = numG + numL
        do j = 1, numVar
          row1(j) = -a(numEqu, j)
        end do
        do i = 1, numG
          a(i, numVar+i) = -1.0
        end do
        do i = 1, numL
          a(numGE+i, numVar+numG+i) = 1.0
        end do
        do i = 1, numGE
          a(i, numVar+numGL+i) = 1.0
        end do
        i = numVar + numGL
        j = i + numGE
        do k = i+1, j
          a(numEqu+1, k) = -1.0
        end do

        sum = 0.0
        do i = 1, numGE
          sum = sum + x(i)
        end do
        x(numEqu+1) = sum

C	end of GetData

	return
	end

	subroutine Exchange(rowType,rowLab,i,j)
	implicit none

	integer d1, i, j
	parameter (d1=1000)
	character*8 rowLab(d1), tmpLab
	character*1 rowType(d1), tmpType

	tmpLab = rowLab(i)
	tmpType = rowType(i)
	rowLab(i) = rowLab(j)
	rowType(i) = rowType(j)
	rowLab(j) = tmpLab
	rowType(j) = tmpType
	return
	end

	integer function SearchRow(label,rowLab,m)
	implicit none

	integer i, m
	character*8 label, rowLab(m)

	do i = 1, m
	    if (label .EQ. rowLab(i)) then
		SearchRow = i
		return
	    endif
	end do
	print *, 'ERROR: unmatched row lable --- ', label
	stop
	end

