1! { dg-do compile }
2! { dg-options "-O2 -fcheck=bounds" }
3
4    FUNCTION F06FKFN(N,W,INCW,X,INCX)
5       IMPLICIT NONE
6       INTEGER, PARAMETER :: WP = KIND(0.0D0)
7       REAL (KIND=WP)                  :: F06FKFN
8       REAL (KIND=WP), PARAMETER       :: ONE = 1.0E+0_WP
9       REAL (KIND=WP), PARAMETER       :: ZERO = 0.0E+0_WP
10       INTEGER, INTENT (IN)            :: INCW, INCX, N
11       REAL (KIND=WP), INTENT (IN)     :: W(*), X(*)
12       REAL (KIND=WP)                  :: ABSYI, NORM, SCALE, SSQ
13       INTEGER                         :: I, IW, IX
14       REAL (KIND=WP), EXTERNAL        :: F06BMFN
15       INTRINSIC                          ABS, SQRT
16       IF (N<1) THEN
17          NORM = ZERO
18       ELSE IF (N==1) THEN
19          NORM = SQRT(W(1))*ABS(X(1))
20       ELSE
21          IF (INCW>0) THEN
22             IW = 1
23          ELSE
24             IW = 1 - (N-1)*INCW
25          END IF
26          IF (INCX>0) THEN
27             IX = 1
28          ELSE
29             IX = 1 - (N-1)*INCX
30          END IF
31          SCALE = ZERO
32          SSQ = ONE
33          DO I = 1, N
34             IF ((W(IW)/=ZERO) .AND. (X(IX)/=ZERO)) THEN
35                ABSYI = SQRT(W(IW))*ABS(X(IX))
36                IF (SCALE<ABSYI) THEN
37                   SSQ = 1 + SSQ*(SCALE/ABSYI)**2
38                   SCALE = ABSYI
39                ELSE
40                   SSQ = SSQ + (ABSYI/SCALE)**2
41                END IF
42             END IF
43             IW = IW + INCW
44             IX = IX + INCX
45          END DO
46          NORM = F06BMFN(SCALE,SSQ)
47       END IF
48       F06FKFN = NORM
49       RETURN
50    END FUNCTION F06FKFN
51
52