OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [pr43796.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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
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
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.