52 lines
1.6 KiB
Fortran
52 lines
1.6 KiB
Fortran
! { dg-do compile }
|
|
! { dg-options "-O2 -fcheck=bounds" }
|
|
|
|
FUNCTION F06FKFN(N,W,INCW,X,INCX)
|
|
IMPLICIT NONE
|
|
INTEGER, PARAMETER :: WP = KIND(0.0D0)
|
|
REAL (KIND=WP) :: F06FKFN
|
|
REAL (KIND=WP), PARAMETER :: ONE = 1.0E+0_WP
|
|
REAL (KIND=WP), PARAMETER :: ZERO = 0.0E+0_WP
|
|
INTEGER, INTENT (IN) :: INCW, INCX, N
|
|
REAL (KIND=WP), INTENT (IN) :: W(*), X(*)
|
|
REAL (KIND=WP) :: ABSYI, NORM, SCALE, SSQ
|
|
INTEGER :: I, IW, IX
|
|
REAL (KIND=WP), EXTERNAL :: F06BMFN
|
|
INTRINSIC ABS, SQRT
|
|
IF (N<1) THEN
|
|
NORM = ZERO
|
|
ELSE IF (N==1) THEN
|
|
NORM = SQRT(W(1))*ABS(X(1))
|
|
ELSE
|
|
IF (INCW>0) THEN
|
|
IW = 1
|
|
ELSE
|
|
IW = 1 - (N-1)*INCW
|
|
END IF
|
|
IF (INCX>0) THEN
|
|
IX = 1
|
|
ELSE
|
|
IX = 1 - (N-1)*INCX
|
|
END IF
|
|
SCALE = ZERO
|
|
SSQ = ONE
|
|
DO I = 1, N
|
|
IF ((W(IW)/=ZERO) .AND. (X(IX)/=ZERO)) THEN
|
|
ABSYI = SQRT(W(IW))*ABS(X(IX))
|
|
IF (SCALE<ABSYI) THEN
|
|
SSQ = 1 + SSQ*(SCALE/ABSYI)**2
|
|
SCALE = ABSYI
|
|
ELSE
|
|
SSQ = SSQ + (ABSYI/SCALE)**2
|
|
END IF
|
|
END IF
|
|
IW = IW + INCW
|
|
IX = IX + INCX
|
|
END DO
|
|
NORM = F06BMFN(SCALE,SSQ)
|
|
END IF
|
|
F06FKFN = NORM
|
|
RETURN
|
|
END FUNCTION F06FKFN
|
|
|