scombssq.f

Go to the documentation of this file.

*> \brief \b SCOMBSSQ adds two scaled sum of squares quantities
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*
*  Definition:
*  ===========
*
*       SUBROUTINE SCOMBSSQ( V1, V2 )
*
*       .. Array Arguments ..
*       REAL               V1( 2 ), V2( 2 )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> SCOMBSSQ adds two scaled sum of squares quantities, V1 := V1 + V2.
*> That is,
*>
*>    V1_scale**2 * V1_sumsq := V1_scale**2 * V1_sumsq
*>                            + V2_scale**2 * V2_sumsq
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in,out] V1
*> \verbatim
*>          V1 is REAL array, dimension (2).
*>          The first scaled sum.
*>          V1(1) = V1_scale, V1(2) = V1_sumsq.
*> \endverbatim
*>
*> \param[in] V2
*> \verbatim
*>          V2 is REAL array, dimension (2).
*>          The second scaled sum.
*>          V2(1) = V2_scale, V2(2) = V2_sumsq.
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup OTHERauxiliary
*
*  =====================================================================
      SUBROUTINE scombssq( V1, V2 )
*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     November 2018
*
*     .. Array Arguments ..
      REAL               V1( 2 ), V2( 2 )
*     ..
*
* =====================================================================
*
*     .. Parameters ..
      REAL               ZERO
      parameter( zero = 0.0d+0 )
*     ..
*     .. Executable Statements ..
*
*     A zero sum V2 shall not modify the scaling factor of V1
      IF( v2( 2 ).EQ.zero ) RETURN
*
      IF( v1( 1 ).GE.v2( 1 ) ) THEN
         IF( v1( 1 ).NE.zero ) THEN
            v1( 2 ) = v1( 2 ) + ( v2( 1 ) / v1( 1 ) )**2 * v2( 2 )
         ELSE
            v1( 2 ) = v1( 2 ) + v2( 2 )
         END IF
      ELSE
         v1( 2 ) = v2( 2 ) + ( v1( 1 ) / v2( 1 ) )**2 * v1( 2 )
         v1( 1 ) = v2( 1 )
      END IF
      RETURN
*
*     End of SCOMBSSQ
*
      END