1*> \brief \b ZLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLA_GEAMV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_geamv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_geamv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_geamv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
22*                              Y, INCY )
23*
24*       .. Scalar Arguments ..
25*       DOUBLE PRECISION   ALPHA, BETA
26*       INTEGER            INCX, INCY, LDA, M, N
27*       INTEGER            TRANS
28*       ..
29*       .. Array Arguments ..
30*       COMPLEX*16         A( LDA, * ), X( * )
31*       DOUBLE PRECISION   Y( * )
32*       ..
33*
34*
35*> \par Purpose:
36*  =============
37*>
38*> \verbatim
39*>
40*> ZLA_GEAMV  performs one of the matrix-vector operations
41*>
42*>         y := alpha*abs(A)*abs(x) + beta*abs(y),
43*>    or   y := alpha*abs(A)**T*abs(x) + beta*abs(y),
44*>
45*> where alpha and beta are scalars, x and y are vectors and A is an
46*> m by n matrix.
47*>
48*> This function is primarily used in calculating error bounds.
49*> To protect against underflow during evaluation, components in
50*> the resulting vector are perturbed away from zero by (N+1)
51*> times the underflow threshold.  To prevent unnecessarily large
52*> errors for block-structure embedded in general matrices,
53*> "symbolically" zero components are not perturbed.  A zero
54*> entry is considered "symbolic" if all multiplications involved
55*> in computing that entry have at least one zero multiplicand.
56*> \endverbatim
57*
58*  Arguments:
59*  ==========
60*
61*> \param[in] TRANS
62*> \verbatim
63*>          TRANS is INTEGER
64*>           On entry, TRANS specifies the operation to be performed as
65*>           follows:
66*>
67*>             BLAS_NO_TRANS      y := alpha*abs(A)*abs(x) + beta*abs(y)
68*>             BLAS_TRANS         y := alpha*abs(A**T)*abs(x) + beta*abs(y)
69*>             BLAS_CONJ_TRANS    y := alpha*abs(A**T)*abs(x) + beta*abs(y)
70*>
71*>           Unchanged on exit.
72*> \endverbatim
73*>
74*> \param[in] M
75*> \verbatim
76*>          M is INTEGER
77*>           On entry, M specifies the number of rows of the matrix A.
78*>           M must be at least zero.
79*>           Unchanged on exit.
80*> \endverbatim
81*>
82*> \param[in] N
83*> \verbatim
84*>          N is INTEGER
85*>           On entry, N specifies the number of columns of the matrix A.
86*>           N must be at least zero.
87*>           Unchanged on exit.
88*> \endverbatim
89*>
90*> \param[in] ALPHA
91*> \verbatim
92*>          ALPHA is DOUBLE PRECISION
93*>           On entry, ALPHA specifies the scalar alpha.
94*>           Unchanged on exit.
95*> \endverbatim
96*>
97*> \param[in] A
98*> \verbatim
99*>          A is COMPLEX*16 array, dimension ( LDA, n )
100*>           Before entry, the leading m by n part of the array A must
101*>           contain the matrix of coefficients.
102*>           Unchanged on exit.
103*> \endverbatim
104*>
105*> \param[in] LDA
106*> \verbatim
107*>          LDA is INTEGER
108*>           On entry, LDA specifies the first dimension of A as declared
109*>           in the calling (sub) program. LDA must be at least
110*>           max( 1, m ).
111*>           Unchanged on exit.
112*> \endverbatim
113*>
114*> \param[in] X
115*> \verbatim
116*>          X is COMPLEX*16 array, dimension at least
117*>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
118*>           and at least
119*>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
120*>           Before entry, the incremented array X must contain the
121*>           vector x.
122*>           Unchanged on exit.
123*> \endverbatim
124*>
125*> \param[in] INCX
126*> \verbatim
127*>          INCX is INTEGER
128*>           On entry, INCX specifies the increment for the elements of
129*>           X. INCX must not be zero.
130*>           Unchanged on exit.
131*> \endverbatim
132*>
133*> \param[in] BETA
134*> \verbatim
135*>          BETA is DOUBLE PRECISION
136*>           On entry, BETA specifies the scalar beta. When BETA is
137*>           supplied as zero then Y need not be set on input.
138*>           Unchanged on exit.
139*> \endverbatim
140*>
141*> \param[in,out] Y
142*> \verbatim
143*>          Y is DOUBLE PRECISION array, dimension
144*>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
145*>           and at least
146*>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
147*>           Before entry with BETA non-zero, the incremented array Y
148*>           must contain the vector y. On exit, Y is overwritten by the
149*>           updated vector y.
150*> \endverbatim
151*>
152*> \param[in] INCY
153*> \verbatim
154*>          INCY is INTEGER
155*>           On entry, INCY specifies the increment for the elements of
156*>           Y. INCY must not be zero.
157*>           Unchanged on exit.
158*>
159*>  Level 2 Blas routine.
160*> \endverbatim
161*
162*  Authors:
163*  ========
164*
165*> \author Univ. of Tennessee
166*> \author Univ. of California Berkeley
167*> \author Univ. of Colorado Denver
168*> \author NAG Ltd.
169*
170*> \date June 2017
171*
172*> \ingroup complex16GEcomputational
173*
174*  =====================================================================
175      SUBROUTINE ZLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
176     $                       Y, INCY )
177*
178*  -- LAPACK computational routine (version 3.7.1) --
179*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
180*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
181*     June 2017
182*
183*     .. Scalar Arguments ..
184      DOUBLE PRECISION   ALPHA, BETA
185      INTEGER            INCX, INCY, LDA, M, N
186      INTEGER            TRANS
187*     ..
188*     .. Array Arguments ..
189      COMPLEX*16         A( LDA, * ), X( * )
190      DOUBLE PRECISION   Y( * )
191*     ..
192*
193*  =====================================================================
194*
195*     .. Parameters ..
196      COMPLEX*16         ONE, ZERO
197      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
198*     ..
199*     .. Local Scalars ..
200      LOGICAL            SYMB_ZERO
201      DOUBLE PRECISION   TEMP, SAFE1
202      INTEGER            I, INFO, IY, J, JX, KX, KY, LENX, LENY
203      COMPLEX*16         CDUM
204*     ..
205*     .. External Subroutines ..
206      EXTERNAL           XERBLA, DLAMCH
207      DOUBLE PRECISION   DLAMCH
208*     ..
209*     .. External Functions ..
210      EXTERNAL           ILATRANS
211      INTEGER            ILATRANS
212*     ..
213*     .. Intrinsic Functions ..
214      INTRINSIC          MAX, ABS, REAL, DIMAG, SIGN
215*     ..
216*     .. Statement Functions ..
217      DOUBLE PRECISION   CABS1
218*     ..
219*     .. Statement Function Definitions ..
220      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
221*     ..
222*     .. Executable Statements ..
223*
224*     Test the input parameters.
225*
226      INFO = 0
227      IF     ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
228     $           .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
229     $           .OR. ( TRANS.EQ.ILATRANS( 'C' ) ) ) ) THEN
230         INFO = 1
231      ELSE IF( M.LT.0 )THEN
232         INFO = 2
233      ELSE IF( N.LT.0 )THEN
234         INFO = 3
235      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
236         INFO = 6
237      ELSE IF( INCX.EQ.0 )THEN
238         INFO = 8
239      ELSE IF( INCY.EQ.0 )THEN
240         INFO = 11
241      END IF
242      IF( INFO.NE.0 )THEN
243         CALL XERBLA( 'ZLA_GEAMV ', INFO )
244         RETURN
245      END IF
246*
247*     Quick return if possible.
248*
249      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
250     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
251     $   RETURN
252*
253*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
254*     up the start points in  X  and  Y.
255*
256      IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
257         LENX = N
258         LENY = M
259      ELSE
260         LENX = M
261         LENY = N
262      END IF
263      IF( INCX.GT.0 )THEN
264         KX = 1
265      ELSE
266         KX = 1 - ( LENX - 1 )*INCX
267      END IF
268      IF( INCY.GT.0 )THEN
269         KY = 1
270      ELSE
271         KY = 1 - ( LENY - 1 )*INCY
272      END IF
273*
274*     Set SAFE1 essentially to be the underflow threshold times the
275*     number of additions in each row.
276*
277      SAFE1 = DLAMCH( 'Safe minimum' )
278      SAFE1 = (N+1)*SAFE1
279*
280*     Form  y := alpha*abs(A)*abs(x) + beta*abs(y).
281*
282*     The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
283*     the inexact flag.  Still doesn't help change the iteration order
284*     to per-column.
285*
286      IY = KY
287      IF ( INCX.EQ.1 ) THEN
288         IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
289            DO I = 1, LENY
290               IF ( BETA .EQ. 0.0D+0 ) THEN
291                  SYMB_ZERO = .TRUE.
292                  Y( IY ) = 0.0D+0
293               ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
294                  SYMB_ZERO = .TRUE.
295               ELSE
296                  SYMB_ZERO = .FALSE.
297                  Y( IY ) = BETA * ABS( Y( IY ) )
298               END IF
299               IF ( ALPHA .NE. 0.0D+0 ) THEN
300                  DO J = 1, LENX
301                     TEMP = CABS1( A( I, J ) )
302                     SYMB_ZERO = SYMB_ZERO .AND.
303     $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
304
305                     Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
306                  END DO
307               END IF
308
309               IF ( .NOT.SYMB_ZERO ) Y( IY ) =
310     $              Y( IY ) + SIGN( SAFE1, Y( IY ) )
311
312               IY = IY + INCY
313            END DO
314         ELSE
315            DO I = 1, LENY
316               IF ( BETA .EQ. 0.0D+0 ) THEN
317                  SYMB_ZERO = .TRUE.
318                  Y( IY ) = 0.0D+0
319               ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
320                  SYMB_ZERO = .TRUE.
321               ELSE
322                  SYMB_ZERO = .FALSE.
323                  Y( IY ) = BETA * ABS( Y( IY ) )
324               END IF
325               IF ( ALPHA .NE. 0.0D+0 ) THEN
326                  DO J = 1, LENX
327                     TEMP = CABS1( A( J, I ) )
328                     SYMB_ZERO = SYMB_ZERO .AND.
329     $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
330
331                     Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
332                  END DO
333               END IF
334
335               IF ( .NOT.SYMB_ZERO ) Y( IY ) =
336     $              Y( IY ) + SIGN( SAFE1, Y( IY ) )
337
338               IY = IY + INCY
339            END DO
340         END IF
341      ELSE
342         IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
343            DO I = 1, LENY
344               IF ( BETA .EQ. 0.0D+0 ) THEN
345                  SYMB_ZERO = .TRUE.
346                  Y( IY ) = 0.0D+0
347               ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
348                  SYMB_ZERO = .TRUE.
349               ELSE
350                  SYMB_ZERO = .FALSE.
351                  Y( IY ) = BETA * ABS( Y( IY ) )
352               END IF
353               IF ( ALPHA .NE. 0.0D+0 ) THEN
354                  JX = KX
355                  DO J = 1, LENX
356                     TEMP = CABS1( A( I, J ) )
357                     SYMB_ZERO = SYMB_ZERO .AND.
358     $                    ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
359
360                     Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
361                     JX = JX + INCX
362                  END DO
363               END IF
364
365               IF ( .NOT.SYMB_ZERO ) Y( IY ) =
366     $              Y( IY ) + SIGN( SAFE1, Y( IY ) )
367
368               IY = IY + INCY
369            END DO
370         ELSE
371            DO I = 1, LENY
372               IF ( BETA .EQ. 0.0D+0 ) THEN
373                  SYMB_ZERO = .TRUE.
374                  Y( IY ) = 0.0D+0
375               ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
376                  SYMB_ZERO = .TRUE.
377               ELSE
378                  SYMB_ZERO = .FALSE.
379                  Y( IY ) = BETA * ABS( Y( IY ) )
380               END IF
381               IF ( ALPHA .NE. 0.0D+0 ) THEN
382                  JX = KX
383                  DO J = 1, LENX
384                     TEMP = CABS1( A( J, I ) )
385                     SYMB_ZERO = SYMB_ZERO .AND.
386     $                    ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
387
388                     Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
389                     JX = JX + INCX
390                  END DO
391               END IF
392
393               IF ( .NOT.SYMB_ZERO ) Y( IY ) =
394     $              Y( IY ) + SIGN( SAFE1, Y( IY ) )
395
396               IY = IY + INCY
397            END DO
398         END IF
399
400      END IF
401*
402      RETURN
403*
404*     End of ZLA_GEAMV
405*
406      END
407