ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
dset.f
Go to the documentation of this file.
1  SUBROUTINE dset( N, ALPHA, X, INCX )
2 *
3 * -- PBLAS auxiliary routine (version 2.0) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * April 1, 1998
7 *
8 * .. Scalar Arguments ..
9  INTEGER INCX, N
10  DOUBLE PRECISION ALPHA
11 * ..
12 * .. Array Arguments ..
13  DOUBLE PRECISION X( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DSET sets the entries of an n vector x to the scalar alpha.
20 *
21 * Arguments
22 * =========
23 *
24 * N (input) INTEGER
25 * On entry, N specifies the length of the vector x. N must be
26 * at least zero.
27 *
28 * ALPHA (input) DOUBLE PRECISION
29 * On entry, ALPHA specifies the scalar alpha.
30 *
31 * X (input/output) DOUBLE PRECISION array of dimension at least
32 * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented
33 * array X must contain the vector x. On exit, entries of the
34 * incremented array X are set to alpha.
35 *
36 * INCX (input) INTEGER
37 * On entry, INCX specifies the increment for the elements of X.
38 * INCX must not be zero.
39 *
40 * -- Written on April 1, 1998 by
41 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
42 *
43 * =====================================================================
44 *
45 * .. Local Scalars ..
46  INTEGER I, INFO, IX, M, MP1
47 * ..
48 * .. External Subroutines ..
49  EXTERNAL xerbla
50 * ..
51 * .. Intrinsic Functions ..
52  INTRINSIC mod
53 * ..
54 * .. Executable Statements ..
55 *
56 * Test the input parameters.
57 *
58  info = 0
59  IF( n.LT.0 ) THEN
60  info = 1
61  ELSE IF( incx.EQ.0 ) THEN
62  info = 4
63  END IF
64  IF( info.NE.0 ) THEN
65  CALL xerbla( 'DSET', info )
66  RETURN
67  END IF
68 *
69 * Quick return if possible.
70 *
71  IF( n.LE.0 )
72  $ RETURN
73 *
74 * Form x := alpha
75 *
76  IF( incx.EQ.1 )
77  $ GO TO 20
78 *
79 * code for increments not equal to 1
80 *
81 * Set up the start point in X.
82 *
83  IF( incx.GT.0 ) THEN
84  ix = 1
85  ELSE
86  ix = 1 - ( n - 1 ) * incx
87  END IF
88 *
89  DO 10 i = 1, n
90  x( ix ) = alpha
91  ix = ix + incx
92  10 CONTINUE
93 *
94  RETURN
95 *
96 * code for increment equal to 1
97 *
98 * clean-up loop
99 *
100  20 m = mod( n, 4 )
101 *
102  IF( m.EQ.0 )
103  $ GO TO 40
104 *
105  DO 30 i = 1, m
106  x( i ) = alpha
107  30 CONTINUE
108  IF( n.LT.4 )
109  $ RETURN
110 *
111  40 mp1 = m + 1
112  DO 50 i = mp1, n, 4
113  x( i ) = alpha
114  x( i + 1 ) = alpha
115  x( i + 2 ) = alpha
116  x( i + 3 ) = alpha
117  50 CONTINUE
118 *
119  RETURN
120 *
121 * End of DSET
122 *
123  END
dset
subroutine dset(N, ALPHA, X, INCX)
Definition: dset.f:2