Subversion Repositories openrisc_2011-10-31

! { 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

                   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