1! Program to test AINT and ANINT intrinsics 2 3subroutine real4test (op, res1, res2) 4 implicit none 5 real(kind=4) :: op 6 real(kind=4) :: res1, res2 7 8 if (diff(aint(op), res1) .or. & 9 diff(anint(op), res2)) STOP 1 10contains 11function diff(a, b) 12 real(kind=4) :: a, b 13 logical diff 14 15 diff = (abs (a - b) .gt. abs(a * 1e-6)) 16end function 17end subroutine 18 19subroutine real8test (op, res1, res2) 20 implicit none 21 real(kind=8) :: op 22 real(kind=8) :: res1, res2 23 24 if (diff(aint(op), res1) .or. & 25 diff(anint(op), res2)) STOP 2 26contains 27function diff(a, b) 28 real(kind=8) :: a, b 29 logical diff 30 31 diff = (abs(a - b) .gt. abs(a * 1e-6)) 32end function 33end subroutine 34 35program aint_aninttest 36 implicit none 37 38 call real4test (3.456, 3.0, 3.0) 39 call real4test (-2.798, -2.0, -3.0) 40 call real4test (3.678, 3.0, 4.0) 41 call real4test (-1.375, -1.0, -1.0) 42 call real4test (-0.5, 0.0,-1.0) 43 call real4test (0.4, 0.0,0.0) 44 45 call real8test (3.456_8, 3.0_8, 3.0_8) 46 call real8test (-2.798_8, -2.0_8, -3.0_8) 47 call real8test (3.678_8, 3.0_8, 4.0_8) 48 call real8test (-1.375_8, -1.0_8, -1.0_8) 49 call real8test (-0.5_8, 0.0_8,-1.0_8) 50 call real8test (0.4_8, 0.0_8,0.0_8) 51 52 ! Check large numbers 53 call real4test (2e34, 2e34, 2e34) 54 call real4test (-2e34, -2e34, -2e34) 55end program 56