PRACE NPT

      Subroutine i_merge( np, nodes, mx, keys, irnkl, itabl, itabr )

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

      Implicit   None

      Integer :: np, nodes, irnkl(np),itabl (nodes+1),itabr (nodes)

      Integer :: mx, keys(mx)

      Integer :: ik, itabk(nodes)

      Integer :: i, j, k, il, ir, ij, irnkj(nodes), jprocs

      Integer :: w(np)

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

!     Make sure that the indices have base 1.

      If ( itabl(1) /= 1) Then

         Do i = nodes+1, 1, -1

            itabl(i) = itabl(i) - itabl(1) + 1

         End Do

      End If

      Do i = 1, nodes

         itabr(i) = itabl(i+1) - 1

      End Do

      Do j = 1,nodes

         itabk(j) = keys(itabl(j))

         irnkj(j) = j

      End Do

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

!     Check for empty segments and remove them.

      jprocs = nodes

      i = 1

      Do j = 1, nodes

         If ( itabl(irnkj(i)) > itabr(irnkj(i))) Then

            jprocs = jprocs - 1

            Do k = i, jprocs

               irnkj(k) = irnkj(k+1)

            End Do

         Else

            i = i + 1

         End If

      End Do

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

!     Sort the proc-way merging table:

      Do j = 2, jprocs

! ---    Consider each of the original elements in turn.

         ij = irnkj(j)

         ik = itabk(ij)

! ---    And look for a place to insert it; The slot "j" is now empty.

         Do i = j-1, 1, -1

            If ( itabk(irnkj(i)) <= ik ) Go To 10

            irnkj(i+1) = irnkj(i)

         End Do

         i = 0

  10     Continue

         irnkj(i+1) = ij

      End Do

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

!     The merging table is now in sorted order.

!     proceed with the merge.

      Do i = 1, np

! ---    Remove the smallest element from the merging list.

         ij = irnkj(1)

! ---    Refresh the merge table.

         il = itabl(ij) + 1

         ir = itabr(ij)

         ik = keys(il)

         itabk(ij) = ik

         itabl(ij) = il

         irnkl(il-1) = i

! ---    Pick out each element in turn; The first slot is now empty.

         If ( ir >= il ) Then ! --- Look for slot to insert new data.

            Do j = 1, jprocs-1

               If ( itabk(irnkj(j+1)) >= ik ) Go To 20

               irnkj(j) = irnkj(j+1)

            End Do

            j = jprocs

  20        Continue

            irnkj(j) = ij

         Else                      ! --- Retire a slot

            jprocs = jprocs-1

            Do j = 1, jprocs

               irnkj(j) = irnkj(j+1)

            End Do

         End If

      End Do

      Do i = 1, np

         w(irnkl(i)) = keys(i)

      End Do

      keys(1:np) = w(1:np)

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

      End Subroutine i_merge