Switch to unified view

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;