blob: 250519af7b7a7470621467b1a06c0e8413a22c84 [file] [log] [blame]
 c { dg-do run } c intrinsic-unix-erf.f c c Test Bessel function intrinsics. c These functions are only available if provided by system c c David Billinghurst c real x, a double precision dx, da logical fail common /flags/ fail fail = .false. x = 0.6 dx = x c ERF - error function a = 0.6038561 da = a call c_r(ERF(x),a,'ERF(real)') call c_d(ERF(dx),da,'ERF(double)') call c_d(DERF(dx),da,'DERF(double)') c ERFC - complementary error function a = 1.0 - a da = a call c_r(ERFC(x),a,'ERFC(real)') call c_d(ERFC(dx),da,'ERFC(double)') call c_d(DERFC(dx),da,'DERFC(double)') if ( fail ) STOP 1 end subroutine failure(label) c Report failure and set flag character*(*) label logical fail common /flags/ fail write(6,'(a,a,a)') 'Test ',label,' FAILED' fail = .true. end subroutine c_r(a,b,label) c Check if REAL a equals b, and fail otherwise real a, b character*(*) label if ( abs(a-b) .gt. 1.0e-5 ) then call failure(label) write(6,*) 'Got ',a,' expected ', b end if end subroutine c_d(a,b,label) c Check if DOUBLE PRECISION a equals b, and fail otherwise double precision a, b character*(*) label if ( abs(a-b) .gt. 1.0d-5 ) then call failure(label) write(6,*) 'Got ',a,' expected ', b end if end