OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [intrinsic-unix-erf.f] - Blame information for rev 437

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
c { dg-do run }
2
c  intrinsic-unix-erf.f
3
c
4
c Test Bessel function intrinsics.  
5
c These functions are only available if provided by system
6
c
7
c     David Billinghurst <David.Billinghurst@riotinto.com>
8
c
9
      real x, a
10
      double precision dx, da
11
      logical fail
12
      common /flags/ fail
13
      fail = .false.
14
 
15
      x = 0.6
16
      dx = x
17
c     ERF  - error function
18
      a = 0.6038561
19
      da = a
20
      call c_r(ERF(x),a,'ERF(real)')
21
      call c_d(ERF(dx),da,'ERF(double)')
22
      call c_d(DERF(dx),da,'DERF(double)')
23
 
24
c     ERFC  - complementary error function
25
      a = 1.0 - a
26
      da = a
27
      call c_r(ERFC(x),a,'ERFC(real)')
28
      call c_d(ERFC(dx),da,'ERFC(double)')
29
      call c_d(DERFC(dx),da,'DERFC(double)')
30
 
31
      if ( fail ) call abort()
32
      end
33
 
34
      subroutine failure(label)
35
c     Report failure and set flag
36
      character*(*) label
37
      logical fail
38
      common /flags/ fail
39
      write(6,'(a,a,a)') 'Test ',label,' FAILED'
40
      fail = .true.
41
      end
42
 
43
      subroutine c_r(a,b,label)
44
c     Check if REAL a equals b, and fail otherwise
45
      real a, b
46
      character*(*) label
47
      if ( abs(a-b) .gt. 1.0e-5 ) then
48
         call failure(label)
49
         write(6,*) 'Got ',a,' expected ', b
50
      end if
51
      end
52
 
53
      subroutine c_d(a,b,label)
54
c     Check if DOUBLE PRECISION a equals b, and fail otherwise
55
      double precision a, b
56
      character*(*) label
57
      if ( abs(a-b) .gt. 1.0d-5 ) then
58
         call failure(label)
59
         write(6,*) 'Got ',a,' expected ', b
60
      end if
61
      end

powered by: WebSVN 2.1.0

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