|
a/F77func.mod |
|
b/F77func.mod |
1 |
IMPLEMENTATION MODULE F77func;
|
1 |
IMPLEMENTATION MODULE F77func;
|
2 |
|
2 |
|
3 |
(*------------------------------------------------------------------------*)
|
3 |
(*------------------------------------------------------------------------*)
|
4 |
(* Funktionen die das Portieren von Fortran-Quellen unterstuetzen. *)
|
4 |
(* Funktionen die das Portieren von Fortran-Quellen unterstuetzen. *)
|
|
|
5 |
(* *)
|
5 |
(* Some Fortran intrinsics which can be used to translate Fortran to M2 *)
|
6 |
(* Some Fortran intrinsics which can be used to translate Fortran to M2 *)
|
6 |
(*------------------------------------------------------------------------*)
|
7 |
(*------------------------------------------------------------------------*)
|
7 |
(* Letzte Veraenderung: *)
|
8 |
(* Letzte Veraenderung: *)
|
8 |
(* *)
|
9 |
(* *)
|
9 |
(* 08.10.15, MRi: Erstellen der 1. Version *)
|
10 |
(* 08.10.15, MRi: Erstellen der 1. Version *)
|
10 |
(* 11.10.15, MRi: MIN0,MAX0 hinzugefuegt. *)
|
11 |
(* 11.10.15, MRi: MIN0,MAX0 hinzugefuegt. *)
|
11 |
(* 05.05.16, MRi: Umbenennen von IntrinsicF77 nach F77func, REAL8, *)
|
12 |
(* 05.05.16, MRi: Umbenennen von IntrinsicF77 nach F77func, REAL8, *)
|
12 |
(* INTEGER4 eingefuehrt. *)
|
13 |
(* INTEGER4 eingefuehrt. *)
|
13 |
(* 28.08.16, MRi: D1Mach hinzugefuegt *)
|
14 |
(* 28.08.16, MRi: D1Mach hinzugefuegt *)
|
|
|
15 |
(* 08.07.18, MRi: IAND, IOR & IEOR hinzugefuegt *)
|
14 |
(*------------------------------------------------------------------------*)
|
16 |
(*------------------------------------------------------------------------*)
|
15 |
(* Offene Punkte: *)
|
17 |
(* Offene Punkte: *)
|
16 |
(* *)
|
18 |
(* *)
|
17 |
(* - Erweiterung um andere Funktionen *)
|
19 |
(* - Erweiterung um andere Funktionen *)
|
18 |
(*------------------------------------------------------------------------*)
|
20 |
(*------------------------------------------------------------------------*)
|
|
... |
|
... |
20 |
(* Licence : GNU Lesser General Public License (LGPL) *)
|
22 |
(* Licence : GNU Lesser General Public License (LGPL) *)
|
21 |
(*------------------------------------------------------------------------*)
|
23 |
(*------------------------------------------------------------------------*)
|
22 |
|
24 |
|
23 |
(* $Id: F77func.mod,v 1.3 2017/07/24 08:47:58 mriedl Exp mriedl $ *)
|
25 |
(* $Id: F77func.mod,v 1.3 2017/07/24 08:47:58 mriedl Exp mriedl $ *)
|
24 |
|
26 |
|
|
|
27 |
FROM SYSTEM IMPORT CAST;
|
25 |
FROM Errors IMPORT ErrOut;
|
28 |
FROM Errors IMPORT ErrOut;
|
26 |
IMPORT LowLong;
|
29 |
IMPORT LowLong;
|
27 |
FROM LMathLib IMPORT MachEps;
|
30 |
FROM LMathLib IMPORT MachEps;
|
28 |
FROM LongMath IMPORT ln,power;
|
31 |
FROM LongMath IMPORT ln,power;
|
29 |
|
32 |
|
|
... |
|
... |
66 |
|
69 |
|
67 |
BEGIN
|
70 |
BEGIN
|
68 |
RETURN LowLong.intpart(x);
|
71 |
RETURN LowLong.intpart(x);
|
69 |
END DINT;
|
72 |
END DINT;
|
70 |
|
73 |
|
|
|
74 |
PROCEDURE IAND(a,b : INTEGER) : INTEGER;
|
|
|
75 |
|
|
|
76 |
BEGIN
|
|
|
77 |
RETURN VAL(INTEGER,(CAST(BITSET,a) * CAST(BITSET,b)));
|
|
|
78 |
END IAND;
|
|
|
79 |
|
|
|
80 |
PROCEDURE IOR(a,b : INTEGER) : INTEGER;
|
|
|
81 |
|
|
|
82 |
BEGIN
|
|
|
83 |
RETURN VAL(INTEGER,(CAST(BITSET,a) + CAST(BITSET,b)));
|
|
|
84 |
END IOR;
|
|
|
85 |
|
|
|
86 |
PROCEDURE IEOR(a,b : INTEGER) : INTEGER;
|
|
|
87 |
|
|
|
88 |
BEGIN
|
|
|
89 |
RETURN VAL(INTEGER,(CAST(BITSET,a) / CAST(BITSET,b)));
|
|
|
90 |
END IEOR;
|
|
|
91 |
|
71 |
PROCEDURE D1Mach(i : INTEGER): LONGREAL;
|
92 |
PROCEDURE D1Mach(i : INTEGER): LONGREAL;
|
72 |
|
93 |
|
73 |
VAR D1Mach : LONGREAL;
|
94 |
VAR D1Mach : LONGREAL;
|
74 |
b : LONGREAL;
|
95 |
b : LONGREAL;
|
75 |
ExpDigits : INTEGER;
|
96 |
ExpDigits : INTEGER;
|