--- a/F77func.mod
+++ b/F77func.mod
@@ -13,6 +13,7 @@
(* INTEGER4 eingefuehrt. *)
(* 28.08.16, MRi: D1Mach hinzugefuegt *)
(* 08.07.18, MRi: IAND, IOR & IEOR hinzugefuegt *)
+ (* 01.01.19, MRi: NINT hinzugefuegt *)
(*------------------------------------------------------------------------*)
(* Offene Punkte: *)
(* *)
@@ -22,10 +23,10 @@
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
- (* $Id: F77func.mod,v 1.3 2017/07/24 08:47:58 mriedl Exp mriedl $ *)
+ (* $Id: F77func.mod,v 1.4 2018/07/08 08:41:20 mriedl Exp mriedl $ *)
FROM SYSTEM IMPORT CAST;
-FROM Errors IMPORT ErrOut;
+FROM Errors IMPORT ErrOut,FatalError;
IMPORT LowLong;
FROM LMathLib IMPORT MachEps;
FROM LongMath IMPORT ln,power;
@@ -70,6 +71,31 @@
BEGIN
RETURN LowLong.intpart(x);
END DINT;
+
+PROCEDURE NINT(x : LONGREAL) : INTEGER;
+
+ VAR i : LONGINT;
+ r : LONGREAL;
+BEGIN
+ IF (ABS(x) > LFLOAT(MAX(INTEGER))+0.5) THEN
+ FatalError("x > MAX(INTEGER) (NINT)");
+ RETURN MAX(INTEGER);
+ END;
+ IF (ABS(x) < LFLOAT(MIN(INTEGER))-0.5) THEN
+ FatalError("x < MIN(INTEGER) (NINT)");
+ RETURN MIN(INTEGER);
+ END;
+ i := INT(TRUNC(ABS(x)));
+ IF (x >= 0.0) THEN
+ r := x - LFLOAT(i);
+ IF (r >= 0.5) THEN INC(i); END;
+ ELSE
+ r := x + LFLOAT(i);
+ IF (r <= -0.5) THEN INC(i); END;
+ i := -i;
+ END;
+ RETURN i;
+END NINT;
PROCEDURE IAND(a,b : INTEGER) : INTEGER;