SUBROUTINE SLARTG7( F, H, G, R, S )
      IMPLICIT NONE
*
*     .. Scalar Arguments ..
      REAL   F, G, H, R, S
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL   ZERO
      PARAMETER          ( ZERO = 0.0E0 )
      REAL   ONE
      PARAMETER          ( ONE = 1.0E0 )
      REAL   TWO
      PARAMETER          ( TWO = 2.0E0 )
*     ..
*     .. Local Scalars ..
*     LOGICAL            FIRST
      INTEGER            COUNT, I
      REAL   EPS, F1, G1, H1, SAFMIN, SAFMN2, SAFMX2, SCALE
      REAL   FHH, FHL, G1H, G1L, P0, E0 
*     ..
*     .. External Functions ..
      REAL   SLAMCH
      EXTERNAL           SLAMCH
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABS, INT, LOG, MAX, SQRT
*     ..
*     .. Save statement ..
*     SAVE               FIRST, SAFMX2, SAFMIN, SAFMN2
*     ..
*     .. Data statements ..
*     DATA               FIRST / .TRUE. /
*     ..
*     .. Executable Statements ..
*
*     IF( FIRST ) THEN
         SAFMIN = SLAMCH( 'S' )
         EPS = SLAMCH( 'E' )
         SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
     $            LOG( SLAMCH( 'B' ) ) / TWO )
         SAFMX2 = ONE / SAFMN2
*        FIRST = .FALSE.
*     END IF
      IF( G.EQ.ZERO ) THEN
         R = F
         S = H
      ELSE IF( F.EQ.ZERO ) THEN
         R = G
         S = ZERO
      ELSE
         F1 = F
         H1 = H
         G1 = G
         SCALE = MAX( ABS( F1 ), ABS( G1 ) )
         IF( SCALE.GE.SAFMX2 ) THEN
            COUNT = 0
   10       CONTINUE
            COUNT = COUNT + 1
            F1 = F1*SAFMN2
            H1 = H1*SAFMN2
            G1 = G1*SAFMN2
            SCALE = MAX( ABS( F1 ), ABS( G1 ) )
            IF( SCALE.GE.SAFMX2 )
     $         GO TO 10

            CALL SQUARE(F1,H1,FHH,FHL)
            CALL TWO_PROD(G1,G1,G1H,G1L)
            CALL ADD(FHH,FHL,G1H,G1L,P0,E0)
            CALL USER_SQRT(P0,E0,R,S)


c            R = SQRT( (F1+H1)**2+G1**2 )
c            S = ZERO

            DO 20 I = 1, COUNT
               R = R*SAFMX2
   20       CONTINUE
            DO 25 I = 1, COUNT
               S = S*SAFMX2
   25       CONTINUE
         ELSE IF( SCALE.LE.SAFMN2 ) THEN
            COUNT = 0
   30       CONTINUE
            COUNT = COUNT + 1
            F1 = F1*SAFMX2
            H1 = H1*SAFMX2
            G1 = G1*SAFMX2
            SCALE = MAX( ABS( F1 ), ABS( G1 ) )
            IF( SCALE.LE.SAFMN2 )
     $         GO TO 30

            CALL SQUARE(F1,H1,FHH,FHL)
            CALL TWO_PROD(G1,G1,G1H,G1L)
            CALL ADD(FHH,FHL,G1H,G1L,P0,E0)
            CALL USER_SQRT(P0,E0,R,S)

c            R = SQRT( (F1+H1)**2+G1**2 )
c            S = ZERO

            DO 40 I = 1, COUNT
               R = R*SAFMN2
   40       CONTINUE
            DO 45 I = 1, COUNT
               S = S*SAFMN2
   45       CONTINUE
         ELSE

            CALL SQUARE(F1,H1,FHH,FHL)
            CALL TWO_PROD(G1,G1,G1H,G1L)
            CALL ADD(FHH,FHL,G1H,G1L,P0,E0)
            CALL USER_SQRT(P0,E0,R,S)

c            R = SQRT( (F1+H1)**2+G1**2 )
c            S = ZERO

         END IF
      END IF
      RETURN
*
*     End of SLARTG7
*
      END

      SUBROUTINE FAST_TWO_SUM(A0,B0,S0,E0)
      IMPLICIT NONE
      REAL A0,B0,S0,E0
      S0=A0+B0
      E0=B0-(S0-A0)
      RETURN
      END SUBROUTINE FAST_TWO_SUM
      
      SUBROUTINE TWO_SUM(A0,B0,S0,E0)
      IMPLICIT NONE
      REAL A0,B0,S0,E0,V0
      S0=A0+B0
      V0=S0-A0
      E0=(A0-(S0-V0))+(B0-V0)
      RETURN
      END SUBROUTINE TWO_SUM
      
      SUBROUTINE ADD(AH,AL,BH,BL,CH,CL)
      IMPLICIT NONE
      REAL AH,AL,BH,BL,CH,CL,SH,EH
      CALL TWO_SUM(AH,BH,SH,EH)
      EH=EH+AL+BL
      CALL FAST_TWO_SUM(SH,EH,CH,CL)
      RETURN
      END SUBROUTINE ADD

      SUBROUTINE ADD2(AH,AL,BH,BL,CH)
      IMPLICIT NONE
      REAL AH,AL,BH,BL,CH,CL,SH,EH
      CALL TWO_SUM(AH,BH,SH,EH)
      EH=EH+AL+BL
      CH=SH+EH
      RETURN
      END SUBROUTINE ADD2

      SUBROUTINE TWO_PROD(A0,B0,P0,E0)
      IMPLICIT NONE
      REAL A0,B0,P0,E0
      REAL   SFMA0
      EXTERNAL SFMA0
      P0=A0*B0
      E0=SFMA0(A0,B0,-P0)
      RETURN
      END SUBROUTINE TWO_PROD

      SUBROUTINE SQUARE(AH,AL,CH,CL)
      IMPLICIT NONE
      REAL AH,AL,CH,CL,P1,P2
      REAL TWO
      PARAMETER          ( TWO = 2.0E0 )
      REAL   SFMA0
      EXTERNAL SFMA0
      CALL TWO_PROD(AH,AH,P1,P2)
      P2=SFMA0(TWO*AL,AH,P2)
      CALL FAST_TWO_SUM(P1,P2,CH,CL)
      RETURN
      END SUBROUTINE SQUARE

      SUBROUTINE USER_SQRT(AH,AL,BH,BL)
      IMPLICIT NONE
      REAL AH,AL,BH,BL,X,CH,CL,DH
      REAL ZERO, HALF, ONE
      PARAMETER          ( ZERO=0.0E0, HALF=0.50E0, ONE=1.0E0 )
      
      X=SQRT(AH)
      CALL TWO_PROD(X,X,CH,CL)
      CALL ADD2(AH,AL,-CH,-CL,DH)
      CALL FAST_TWO_SUM(X,HALF*DH/X,BH,BL)

      RETURN
      END SUBROUTINE USER_SQRT