d2/dee/scsum1_8f_source.html

00001       REAL             FUNCTION SCSUM1( N, CX, INCX )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            INCX, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       COMPLEX            CX( * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  SCSUM1 takes the sum of the absolute values of a complex
00019 *  vector and returns a single precision result.
00020 *
00021 *  Based on SCASUM from the Level 1 BLAS.
00022 *  The change is to use the 'genuine' absolute value.
00023 *
00024 *  Contributed by Nick Higham for use with CLACON.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  N       (input) INTEGER
00030 *          The number of elements in the vector CX.
00031 *
00032 *  CX      (input) COMPLEX array, dimension (N)
00033 *          The vector whose elements will be summed.
00034 *
00035 *  INCX    (input) INTEGER
00036 *          The spacing between successive values of CX.  INCX > 0.
00037 *
00038 *  =====================================================================
00039 *
00040 *     .. Local Scalars ..
00041       INTEGER            I, NINCX
00042       REAL               STEMP
00043 *     ..
00044 *     .. Intrinsic Functions ..
00045       INTRINSIC          ABS
00046 *     ..
00047 *     .. Executable Statements ..
00048 *
00049       SCSUM1 = 0.0E0
00050       STEMP = 0.0E0
00051       IF( N.LE.0 )
00052      $   RETURN
00053       IF( INCX.EQ.1 )
00054      $   GO TO 20
00055 *
00056 *     CODE FOR INCREMENT NOT EQUAL TO 1
00057 *
00058       NINCX = N*INCX
00059       DO 10 I = 1, NINCX, INCX
00060 *
00061 *        NEXT LINE MODIFIED.
00062 *
00063          STEMP = STEMP + ABS( CX( I ) )
00064    10 CONTINUE
00065       SCSUM1 = STEMP
00066       RETURN
00067 *
00068 *     CODE FOR INCREMENT EQUAL TO 1
00069 *
00070    20 CONTINUE
00071       DO 30 I = 1, N
00072 *
00073 *        NEXT LINE MODIFIED.
00074 *
00075          STEMP = STEMP + ABS( CX( I ) )
00076    30 CONTINUE
00077       SCSUM1 = STEMP
00078       RETURN
00079 *
00080 *     End of SCSUM1
00081 *
00082       END