Silverfrost Logo About Us | Contact Us
 

IEEE Standard 754 Special Floating Point Numbers

The following sample code illustrates how special floating point values can be managed in FTN95:

SUBROUTINE SpecialNumber(in, out)
CHARACTER(LEN=*) in
DOUBLE PRECISION out
out = 0.0D0
CALL UPCASE@(in)
SELECT CASE(in)
 CASE("MINUS_ZERO")
  DCORE8(LOC(out)) = Z'8000000000000000'D
 CASE("MINUS_INFINITY")
  DCORE8(LOC(out)) = Z'FFF0000000000000'D
 CASE("PLUS_INFINITY")
  DCORE8(LOC(out)) = Z'7FF0000000000000'D
 CASE("NOT_A_NUMBER")
  DCORE8(LOC(out)) = Z'FFFFFFFFFFFFFFFF'D
 CASE("UNDEFINED")
  DCORE8(LOC(out)) = Z'8080808080808080'D
END SELECT
END

LOGICAL FUNCTION IsSpecialNumber(in, val)
CHARACTER(LEN=*) in
DOUBLE PRECISION val
LOGICAL res
res = .FALSE.
CALL UPCASE@(in)
SELECT CASE(in)
 CASE("MINUS_ZERO")
  res = CORE4(LOC(val)+4)==Z'80000000'.AND.CORE4(LOC(val))==0
 CASE("MINUS_INFINITY")
  res = CORE4(LOC(val)+4)==Z'FFF00000'.AND.CORE4(LOC(val))==0
 CASE("PLUS_INFINITY")
  res = CORE4(LOC(val)+4)==Z'7FF00000'.AND.CORE4(LOC(val))==0
 CASE("NOT_A_NUMBER")
  res = CORE4(LOC(val)+4)==Z'FFFFFFFF'.AND.CORE4(LOC(val))==Z'FFFFFFFF'
 CASE("UNDEFINED")
  res = CORE4(LOC(val)+4)==Z'80808080'.AND.CORE4(LOC(val))==Z'80808080'
END SELECT
IsSpecialNumber = res
END

PROGRAM test
 DOUBLE PRECISION val
 LOGICAL IsSpecialNumber
 CALL SpecialNumber("MINUS_INFINITY",val)
 IF(IsSpecialNumber("MINUS_INFINITY",val)) PRINT*,"OK"
END

 

 

Copyright © 1999-2017 Silverfrost Limited