LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
dcombssq.f
Go to the documentation of this file.
1 *> \brief \b DCOMBSSQ adds two scaled sum of squares quantities.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *
9 * Definition:
10 * ===========
11 *
12 * SUBROUTINE DCOMBSSQ( V1, V2 )
13 *
14 * .. Array Arguments ..
15 * DOUBLE PRECISION V1( 2 ), V2( 2 )
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> DCOMBSSQ adds two scaled sum of squares quantities, V1 := V1 + V2.
25 *> That is,
26 *>
27 *> V1_scale**2 * V1_sumsq := V1_scale**2 * V1_sumsq
28 *> + V2_scale**2 * V2_sumsq
29 *> \endverbatim
30 *
31 * Arguments:
32 * ==========
33 *
34 *> \param[in,out] V1
35 *> \verbatim
36 *> V1 is DOUBLE PRECISION array, dimension (2).
37 *> The first scaled sum.
38 *> V1(1) = V1_scale, V1(2) = V1_sumsq.
39 *> \endverbatim
40 *>
41 *> \param[in] V2
42 *> \verbatim
43 *> V2 is DOUBLE PRECISION array, dimension (2).
44 *> The second scaled sum.
45 *> V2(1) = V2_scale, V2(2) = V2_sumsq.
46 *> \endverbatim
47 *
48 * Authors:
49 * ========
50 *
51 *> \author Univ. of Tennessee
52 *> \author Univ. of California Berkeley
53 *> \author Univ. of Colorado Denver
54 *> \author NAG Ltd.
55 *
56 *> \ingroup OTHERauxiliary
57 *
58 * =====================================================================
59  SUBROUTINE dcombssq( V1, V2 )
60 *
61 * -- LAPACK auxiliary routine --
62 * -- LAPACK is a software package provided by Univ. of Tennessee, --
63 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
64 * November 2018
65 *
66 * .. Array Arguments ..
67  DOUBLE PRECISION V1( 2 ), V2( 2 )
68 * ..
69 *
70 * =====================================================================
71 *
72 * .. Parameters ..
73  DOUBLE PRECISION ZERO
74  parameter( zero = 0.0d+0 )
75 * ..
76 * .. Executable Statements ..
77 *
78 * A zero sum V2 shall not modify the scaling factor of V1
79  IF( v2( 2 ).EQ.zero ) RETURN
80 *
81  IF( v1( 1 ).GE.v2( 1 ) ) THEN
82  IF( v1( 1 ).NE.zero ) THEN
83  v1( 2 ) = v1( 2 ) + ( v2( 1 ) / v1( 1 ) )**2 * v2( 2 )
84  ELSE
85  v1( 2 ) = v1( 2 ) + v2( 2 )
86  END IF
87  ELSE
88  v1( 2 ) = v2( 2 ) + ( v1( 1 ) / v2( 1 ) )**2 * v1( 2 )
89  v1( 1 ) = v2( 1 )
90  END IF
91  RETURN
92 *
93 * End of DCOMBSSQ
94 *
95  END
subroutine dcombssq(V1, V2)
DCOMBSSQ adds two scaled sum of squares quantities.
Definition: dcombssq.f:60