      SUBROUTINE HSYRK ( UPLO, TRANS, N, K, nn, ALPHA, A, LDA,
     $                   BETA, C, LDC , ncols, nprocs)
      IMPLICIT NONE
*     .. Scalar Arguments ..
      CHARACTER*1        UPLO, TRANS
      INTEGER            N, K, LDA, LDC
      integer            stride,nprocs,jj,jc,ncols,kk,nn
      REAL*8             ALPHA, BETA
*     .. Array Arguments ..
      REAL*8             A( LDA, * ), C( LDC, * )
*     ..
*
*  Purpose
*  =======
*
*  Modified DSYRK routine which updates wrap-mapped panels
*  (USES DSYRK AND DGEMM)

*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     .. Local Scalars ..
      LOGICAL            UPPER
      INTEGER            I, INFO, J, NROWA
*     .. Parameters ..
      REAL*8             ONE ,         ZERO
      PARAMETER        ( ONE = 1.0E+0, ZERO = 0.0E+0 )

*
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      IF( LSAME( TRANS, 'N' ) )THEN
         NROWA = N
      ELSE
         NROWA = K
      END IF
      UPPER = LSAME( UPLO, 'U' )
*
      INFO = 0
      IF(      ( .NOT.UPPER               ).AND.
     $         ( .NOT.LSAME( UPLO , 'L' ) )      )THEN
         INFO = 1
      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ).AND.
     $         ( .NOT.LSAME( TRANS, 'T' ) ).AND.
     $         ( .NOT.LSAME( TRANS, 'C' ) )      )THEN
         INFO = 2
      ELSE IF( N  .LT.0               )THEN
         INFO = 3
      ELSE IF( K  .LT.0               )THEN
         INFO = 4
      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
         INFO = 7
      ELSE IF( LDC.LT.MAX( 1, N     ) )THEN
         INFO = 10
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'HSYRK ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( N.EQ.0 ).OR.
     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
     $   RETURN
*
*     And when  alpha.eq.zero.
*
      IF( ALPHA.EQ.ZERO )THEN
         IF( UPPER )THEN
            IF( BETA.EQ.ZERO )THEN
               DO 20, J = 1, N
                  DO 10, I = 1, J
                     C( I, J ) = ZERO
   10             CONTINUE
   20          CONTINUE
            ELSE
               DO 40, J = 1, N
                  DO 30, I = 1, J
                     C( I, J ) = BETA*C( I, J )
   30             CONTINUE
   40          CONTINUE
            END IF
         ELSE
            IF( BETA.EQ.ZERO )THEN
               DO 60, J = 1, N
                  DO 50, I = J, N
                     C( I, J ) = ZERO
   50             CONTINUE
   60          CONTINUE
            ELSE
               DO 80, J = 1, N
                  DO 70, I = J, N
                     C( I, J ) = BETA*C( I, J )
   70             CONTINUE
   80          CONTINUE
            END IF
         END IF
         RETURN
      END IF
*
*     Start the operations.
*
      IF( LSAME( TRANS, 'N' ) )THEN
*
*        Form  C := alpha*A*A' + beta*C.
*

         IF( .NOT.UPPER )THEN

	    stride = nprocs * k
            jc = 0
            DO 180 JJ = 1, nn, stride
	       kk = min(ncols-jc,k)
	          call dsyrk('L','N',kk,k,alpha,a(jj,1),lda,
     $                       beta,c(jj,jc+1),ldc)
        	  if ((n-jj-k+1) .gt. 0) then
                  call dgemm('N','T',n-(jj+k)+1,kk,k,alpha,
     $                       a(jj+k,1),lda,a(jj,1),lda,beta,
     $                       c(jj+k,jc+1),ldc)
                  endif
                  jc = jc + k
  180       CONTINUE
         END IF

      ENDIF
      RETURN
*
*     End of HSYRK .
*
      END

