subroutine p5(n,nz, col_ptr, row_ind, col_perm, row_perm,
     1                block_id, block_ptr, stack, stack_inv, 
     1                row_count, col_count, min_col, 
     1                list_candidate, candidate, border_ptr,error)
c**********************************************************************
c	Apply P5 to the diagnal block(i).
c
c	During the application of P5 to the diagnal block, we speak
c	of an "active" submatrix. Initially all rows and columns in 
c	the diagnal block are active. Columns become inactive by being
c	chosen to be spikes and/or by being assigned into final position
c	in the nested block bordered triangular form. Rows become inactive
c	by being assigned to final position. The row-counts in the procedures 
c	that follow refer only to the active submatrix.
c***************************************************************************

c***********************************************************************
c	Arguments:
c
c	n - integer: the order of the matrix
c	nz - integer: the number of non-zero elements in the matrix
c	max_row - integer: the dimension of the row_ind array
c	max_col - integer: the dimension of the col_ind array
c	value - double precision(nz): the values for each element
c	    of the array
c	row_ind - integer(max_row): this array contains the row
c	    indices for each of the elements in the array
c	col_ind - integer(max_col): this array contains the column
c	    indices for each of the elements in the array
c	col_ptr - integer(n+1): contains a pointer to the start of
c	    each column
c	row_perm - integer(n): row permutation
c	col_perm - integer(n): column permutation
c	nblocks - integer: the number of blocks found
c	block_ptr - integer(n): pointer to the first row in each block
c	iwork - integer(n,13): this is also work space
c	dwork - double precision(n): this is double precision work space
c	iflag - integer: this is the error return flag
c***********************************************************************
c***********************************************************************
c---------------------------------------------------------
c	data passing between subroutins
c---------------------------------------------------------

	integer n, nz 
	integer block_id
	integer stack(n)
	integer stack_inv(n)
	integer block_ptr(n)
	integer border_ptr(n)
	integer col_perm(n), row_perm(n)
	integer col_ptr(n+1), row_ind(nz)
c---------------------------------------------------------
c	working space
c---------------------------------------------------------
	integer row_count(n), col_count(n)
	integer min_col(n), candidate(n), list_candidate(n)
	integer col, row, m, m1, m_2, s, error, flag, q, temp
	integer spike, spike_top, start, end, lead, end_m
	integer end_blk, end_col, ncol, up, central, down
	logical assign
c	begin
c-------------------------------------------------------------------------
c	Remove columns from the active matrix (call them spikes) until
c	the triangular part of the bordered form can be extended,i.e., 
c	until the row-count of some row in the active matrix is reduced
c	to one.
c-------------------------------------------------------------------------
c	initialization
c-------------------------------------------------------------------------
	start = block_ptr(block_id)
	end_blk = block_ptr(block_id+1)-1
	end = block_ptr(block_id+1)-1
	ncol = end-start+1
	end_m = end
	do i = start,end_blk
	    col_perm(i) = stack(i)
	    row_perm(i) = i
	enddo
	lead = start
	spike_top = end_blk
c	------------------------------------------------------
c	sort the rows to the prefered form.	
c	------------------------------------------------------
	jj = end
	central = start+((end-start)*80)/100
 	up = central
	down = up+1
	do while (jj.ge.start .and. (up.ge.start .or. down.le.end_blk))
	    j = col_perm(jj)
	    do ii = col_ptr(j), col_ptr(j+1)-1
		i = row_perm(stack_inv(row_ind(ii)))
		if (i.le.central .and. i.ge.start) then
		    row_perm(stack_inv(row_ind(ii))) = -up
		    up = up - 1
		elseif(i.le.end_blk .and. i.ge.central+1) then
		    row_perm(stack_inv(row_ind(ii))) = -down
		    down = down + 1
		endif
	    enddo
	    jj = jj - 1
	enddo
	do i = start,end_blk
	    if (row_perm(i).lt. 0 ) row_perm(i) = -row_perm(i)
	enddo
c	------------------------------------------------------
c	After initialization, 'stack' is no longer useful, then
c	use it as a block_ptr (ext).
c	-------------------------------------------------------
	do i = start, end_blk
	    stack(i) = 0
	enddo
	stack(start) = start 
	len4 = start 
c	end_col = min(start+ncol, end)
c-------------------------------------------------------------------------
c	get row_count and col_count
c-------------------------------------------------------------------------
2000	continue
c
c	reset the active column end.
c
	end_col = min(lead+ncol, end)
c	write(0,*) 'end_col=',end_col
	if (end_col .lt. lead) goto 3000
	do i = lead, spike_top
	    row_count(i) = 0
	enddo
	do i = lead, end_col
	    col_count(i) = 0
	enddo
	m1 = spike_top - lead + 1
	do j = lead, end_col
200	    continue
	    jj = col_perm(j)
	    do ii = col_ptr(jj), col_ptr(jj+1)-1
		i = row_perm(stack_inv(row_ind(ii)))
		if ( lead .le. i .and. i.le. spike_top ) then
		    row_count(i) = row_count(i) + 1
		    col_count(j) = col_count(j) + 1
		endif
	    enddo
	    if (col_count(j).eq.0.and.j.le.end) then
	 	temp = col_perm(j)
		col_perm(j) = col_perm(end)
		col_perm(end) = temp
		end = end - 1
c		write(0,*) 'there is a blank col'
		goto 200
	    elseif (m1.gt.col_count(j).and.col_count(j).ne.0) then
                m1 = col_count(j)
	    endif
	enddo
	if (end.lt.end_col) end_col = end
	m = m1
c	print *,'row_count is got'
c-------------------------------------------------------------------------
c	get min_col 
c-------------------------------------------------------------------------

1000	continue
	ii = lead
	do while (col_count(ii).eq.0 .and. ii .le.end_col)
	    ii = ii + 1
	enddo
	if(col_count(ii).ne.0 .and. ii .le. end_col) then
	    min_col(start) = ii
	    len1 = start
	else
	    goto 3000
	endif
	do i = ii+1, end_col
	    if (col_count(i).ne.0) then
		if (col_count(i)-col_count(min_col(len1))) 10, 20, 30

10		    min_col(start) = i
		    len1 = start
		    goto 30

20	 	    len1 = len1 + 1
		    min_col(len1) = i

30		    continue
		endif
	enddo
	if (m .ne. col_count(min_col(start))) then
	    error = 4
	    print *,'m:',m,'m1',m1,col_count(min_col(start))
	    goto 3200
	endif

c-------------------------------------------------------------------------
c	get candidate (row)
c-------------------------------------------------------------------------

	do i = lead, spike_top
	    candidate(i) = 0
	enddo
	do k = start, len1
	    jj = min_col(k)
	    j = col_perm(jj)
	    do ii = col_ptr(j), col_ptr(j+1)-1
	    	i = row_perm(stack_inv(row_ind(ii)))
		if ( lead.le.i .and. i.le.spike_top) then
		    candidate(i) = candidate(i) + 1
		endif
	    enddo
	enddo

	len2 = start
	list_candidate(start) = lead
	do i = lead+1, spike_top
	    if( candidate(list_candidate(len2))-candidate(i)) 21,22,23

21		len2 = start
		list_candidate(len2) = i
		goto 23

22		len2 = len2 + 1
		list_candidate(len2) = i
		goto 23

23		continue
c	    endif
	enddo
	num_candidate = len2-start+1
c	print *,'number of candidates is ',num_candidate
	s = candidate(len2)
	
	if (m.eq.spike_top-lead+1.and.num_candidate.gt.0) then
c	----------------------------------------------------
c	permute min(m, num_candidate) columns to pivot.
c	----------------------------------------------------
	    col = lead
	    do i = lead, end_col
		if (col.gt.spike_top) goto 1100
		if (col_count(i).eq.m) then
		temp = col_perm(col)
		col_perm(col) = col_perm(i)
		col_perm(i) = temp
		col = col + 1
		endif
	    enddo
1100	    lead = col
	    if (len4.lt.end_blk) then
	    len4 = len4 + 1
	    stack(len4) = lead
	    else
	    goto 3200
	    endif
	    goto 3000
	endif
c------------------------------------------------------------------

	if (num_candidate .gt. 1 .and. s .eq. 1) then
c	print *,'this is in special case'
c------------------------------------------------------------------
c	get sec_min_col
c------------------------------------------------------------------

	kk = lead
	l = 0
	do while (kk .le. end_col)
    	    if (col_count(kk).gt.m) then
		j = col_perm(kk)
		do jj = col_ptr(j),col_ptr(j+1)-1
		    i = row_perm(stack_inv(row_ind(jj)))
		    if ( candidate(i) .eq. s ) then
			l = kk
		    endif
		enddo
		if (l.ne.0) then
			kk = end_col
		endif
	    endif
	    kk = kk + 1
	enddo
	min_col(start) = l
	len1 = start
	do k = l+1, end_col
    	    if (col_count(k).gt.m) then
		j = col_perm(k)
		do jj = col_ptr(j),col_ptr(j+1)-1
		    i = row_perm(stack_inv(row_ind(jj)))
		    if ( candidate(i) .eq. s ) then
	    		if(col_count(k)-col_count(min_col(len1))) 
     1                               31, 32, 33

31		   		 min_col(start) = k
		    	 	 len1 = start
		    		 goto 33

32	 	    		 len1 = len1 + 1
		    		 min_col(len1) = k

33		    		 continue
			continue
		    endif
		enddo
	    endif
	enddo
	m_2 = col_count(min_col(start))

c-------------------------------------------------------------------------
c	get candidate (from the candidate set) 
c-------------------------------------------------------------------------
	do i = lead, spike_top
	    candidate(i) = 0
	enddo
	do k = start, len1
	    jj = min_col(k)
	    j = col_perm(jj)
	    do ii = col_ptr(j), col_ptr(j+1)-1
	    	i = row_perm(stack_inv(row_ind(ii)))
		if ( lead.le.i .and. i.le.spike_top) then
		    candidate(i) = candidate(i) + 1
		endif
	    enddo
	enddo

c	reduce the candidates

	len3 = start
	do i = start, len2
	    j = list_candidate(i)
	    if ( candidate(j).eq.m_2) then
		list_candidate(len3) = j
		len3 = len3 + 1
	    endif
	enddo
	len2 = len3
	num_candidate = len3 - start 
c	print *,'the reduced candidate:',num_candidate

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

	endif

c------------------------------------------------------------------
c	choose spike ( from the list_candidate)
c------------------------------------------------------------------

c	print *,'choose th espike'
	if (num_candidate.gt.1) then
	spike = list_candidate(start)
	do i = start + 1, len2
	    k = list_candidate(i)
	    if ( row_count(spike) .lt. row_count(k)) spike = k
	enddo
	else
	spike = list_candidate(start)
	endif
c	print *,'the spike is ',spike

c------------------------------------------------------------------
c	put spike in stack (reset the row_perm) if m <> 1.
c------------------------------------------------------------------

	flag = 0
	do i = start,end_blk
c	print*, row_perm(i)
	    if ( row_perm(i).eq.spike) then
		row_perm(i) = spike_top
		flag = flag+1
	    else if (row_perm(i) .eq. spike_top) then
		row_perm(i) = spike
		flag = flag+1
	    endif
	enddo
c	if (flag .ne. 2) then
c	  print *,'there is problem in spike assignment'
c	  print *,spike, spike_top, m, m1, lead
c	endif

c	modify the row_count
	temp = row_count(spike)
	row_count(spike) = row_count(spike_top)
	row_count(spike_top) = temp

	if (m .gt. 1) then
c	print *,'modify the col_count'
	do i = lead, end_col
	    j = col_perm(i)
	    do jj = col_ptr(j),col_ptr(j+1)-1
		if ( row_perm(stack_inv(row_ind(jj))).eq.spike_top) then
		    col_count(i) = col_count(i)-1
		endif
	    enddo
	enddo
	endif
	spike_top = spike_top-1
	m = m - 1

c	print *,'the spike is put into stack now'

	if (m.ge.1) goto 1000
c------------------------------------------------------------------

c	endif

c----------------------------------------------------------------------
c	Extend the triangular portion of the bordered triangular form
c	by asigning a column that has the only nonzero in some row of 
c	row_count one, and perhaps also assigning some spikes from the 
c	stack. Assign as many row as columns.
c----------------------------------------------------------------------

c	------------------------------------
c	asign pivots;
c	------------------------------------
c	q = row_count(spike_top+1)
c	print *,'assign the pivots'
c	print *,'the spike is ',spike
	col = 0
	do i1 = lead, end_col
	    if (col_count(i1).eq.1.and.col.lt.m1) then
	   	ii = col_perm(i1)
		do k = col_ptr(ii), col_ptr(ii+1)-1
	        kk = row_perm(stack_inv(row_ind(k)))
	        if (kk.eq.spike_top+1) then
	
		temp = col_perm(lead+col)
		col_perm(lead+col) = col_perm(i1)
		col_perm(i1) = temp
		col = col + 1

		endif
		enddo
	    endif
	enddo
	if (col.eq.0) then
	  print *,'col =',col, 'm1=',m1
	  print *,'spike:',spike,'spike_top:',spike_top+1
	do i1 = lead, end_col
	    if (col_count(i1).eq.1.and.col.lt.m1) then
	  print *,'the col',i1,'has col_count=1'
	  print *,'the row ind are:'
	   	ii = col_perm(i1)
		do k = col_ptr(ii), col_ptr(ii+1)-1
	        kk = row_perm(stack_inv(row_ind(k)))
		print *,kk
		enddo
	    endif
	enddo
	print *,'all the candidate:'
	print *,list_candidate(start:len2)
	print *,'min_col(start:len1)'
	print *,min_col(start:len1)
	print *,'all the col_count of min_col'
	do i = start,len1
		print*, (col_count(min_col(i)))
	enddo
	
	endif
c	---------------------------------------------
c	permute col last spikes to the lead pivots.
c	---------------------------------------------
	    do i = start,end_blk
	    if  (row_perm(i).ge.lead .and.
     1           row_perm(i).lt.lead+col) then
		row_perm(i) = spike_top+(row_perm(i)-lead+1)
	    elseif( row_perm(i).gt.spike_top .and.
     1           row_perm(i).le.spike_top+col) then
		row_perm(i) = lead+(spike_top+col-row_perm(i))
	    endif
	    enddo
	lead = lead + col
	spike_top = spike_top + col

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

3100	end_m = spike_top
	if(len4.lt.end_blk) then
	len4 = len4 + 1
	stack( len4 ) = lead
	else
	goto 3200
	endif
	if ( lead .le. spike_top ) goto 2000
3000	continue

c------------------------------------------------------
c	set the border_ptr
c------------------------------------------------------
	if (len4.le.end_blk) stack(len4) = -lead
3200	border_ptr(block_id) = lead
c	write(0,*) stack(start:end_blk)
	return
	end