	subroutine dpacku ( packup, uplo, n, na, fulla )
****************************************************************************
*                                                                          *
*   DATA PARALLEL BLAS based on MPL                                        *
*                                                                          *
*   Version 1.0   1/9-92 ,                                                 *
*   For MasPar MP-1 computers                                              *
*                                                                          *
*   para//ab, University of Bergen, NORWAY                                 *
*                                                                          *
*   These programs must be called using F90 style array syntax.            *
*   Note that the F77 style calling sequence has been retained             *
*   in this version for compatibility reasons, be aware that               *
*   parameters related to the array dimensions and shape therefore may     *
*   be redundant and without any influence.                                *
*   The calling sequence may be changed in a future version.               *
*   Please report any BUGs, ideas for improvement or other                 *
*   comments to                                                            *
*                    adm@parallab.uib.no                                   *
*                                                                          *
*   Future versions may then reflect your suggestions.                     *
*   The most current version of this software is available                 *
*   from netlib@nac.no , send the message `send index from maspar'         *
*                                                                          *
*   REVISIONS:                                                             *
*                                                                          *
****************************************************************************
c
	integer n, na
	double precision, array(n,n) :: fulla
	double precision, array(na) :: packup
	character*1 uplo
	logical   lsame
	external  lsame
c
c   local variables
c
	integer, array(n,n) :: nrow, ncol, whereis
*
*     Set up the where array
*
cts     do i = 1 , n
cts             ncol(:,i) = i
cts             nrow(i,:) = i
cts     enddo
        forall (i=1:n,j=1:n) ncol(i,j) = j
        forall (i=1:n,j=1:n) nrow(i,j) = i
c
	if ( lsame (uplo, 'U') ) then
	   whereis = ncol
	   whereis = (whereis * (whereis-1)) / 2
	   whereis = whereis + nrow
c
c   so if whereis is 4 by 4 then it now stores
c
c	1	2	4	7
c	2	3	5	8
c	3	4	6	9
c	4	5	7      10
c
	else
	   whereis = n + 1 - ncol
	   whereis = (n*(n-1)) / 2 - ((whereis*(whereis-1)) / 2)
	   whereis = whereis + nrow
c
c   so if whereis is 4 by 4 then it now stores
c
c	1	4	6	7
c	2	5	7	8
c	3	6	8	9
c	4	7	9      10
c
	endif
c
c
c   set up fulla by getting data from ap(whereis)
c
	if ( lsame (uplo, 'U') ) then
cpb	    forall (i = 1:n, j=1:n, i .le. j)
cpb     &          packup(whereis(i,j)) = fulla(i,j)
   		do j = 1 , n
   		packup(whereis(1:j,j)) = fulla(1:j,j)
   		enddo
cts		do j = 1 , n
cts		do i = 1 , j
cts		packup(whereis(i,j)) = fulla(i,j)
cts		enddo
cts		enddo
cpb
	else
cpb	    forall (i = 1:n, j=1:n, i .ge. j)
cpb   &          packup(whereis(i,j)) = fulla(i,j)
   		do j = 1 , n
   		packup(whereis(j:n,j)) = fulla(j:n,j)
   		enddo
cts		do j = 1 , n
cts		do i = j , n
cts		packup(whereis(i,j)) = fulla(i,j)
cts		enddo
cts		enddo
	endif
	return
	end