c
c blas.f

      SUBROUTINE AXPY ( N, A, X, Y, INDIR)
      REAL   A, X(*), Y(*)
      INTEGER INDIR(*)

      REAL   ZERO
      PARAMETER        ( ZERO = 0.0 )

      IF (A .NE. ZERO) THEN
         DO 10 I = 1, N
            Y(INDIR(I)) = A * X(INDIR(I))  +  Y(INDIR(I))
   10    CONTINUE
      END IF

*     End of AXPY
      END

      SUBROUTINE COPY ( N, X, Y )
      REAL   X(N), Y(N)

      DO 10 I = 1, N
         Y(I) = X(I)
   10 CONTINUE

*     End of COPY
      END

      FUNCTION   DOT  ( N, X, Y, INDIR )
      REAL   DOT, X(*), Y(*), work
      INTEGER INDIR(*)
#if defined CM5
#include "../include/machine/cm5.fort.h"
#elif defined INTEL
#include "../include/machine/intel.fort.h"
#elif defined SP1
#include "../include/machine/sp1.fort.h"
#endif

      REAL   SUM
      REAL   ZERO
      PARAMETER        ( ZERO = 0.0 )

      SUM     = ZERO
      DO 10 I = 1, N
         SUM  = X(INDIR(I)) * Y(INDIR(I))  +  SUM
   10 CONTINUE

      call PARTI_gssum(sum , 1, work)

      DOT    = SUM

*     End of DOT
      END

      FUNCTION   NRM2 ( N, X, INDIR )
#if defined CM5
#include "../include/machine/cm5.fort.h"
#elif defined INTEL
#include "../include/machine/intel.fort.h"
#elif defined SP1
#include "../include/machine/sp1.fort.h"
#endif
      REAL   NRM2, X(*), work
      INTEGER INDIR(N)

      INTRINSIC          SQRT
      REAL   SUM
      REAL   ZERO
      PARAMETER        ( ZERO = 0.0 )

      SUM     = ZERO
      DO 10 I = 1, N
         SUM  = X(INDIR(I))**2 + SUM
   10 CONTINUE

      call PARTI_gssum(sum, 1, work)

      NRM2   = SQRT( SUM )

*     End of NRM2
      END


      SUBROUTINE SWAP (N, X, Y, INDIR)
      REAL X(*), Y(*), TEMP
      INTEGER I, N, INDIR(N)
      DO 100 I = 1, N
	 TEMP = Y(INDIR(I))
	 Y(INDIR(I)) = X(INDIR(I))
	 X(INDIR(I)) = TEMP
  100 CONTINUE
      RETURN
      END


