[139f46]: F77func.mod History

Parent: [3445a0] (diff)

Child: [28b809] (diff)

Download this file

F77func.mod    123 lines (96 with data), 4.1 kB 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
IMPLEMENTATION MODULE F77func;



  (*------------------------------------------------------------------------*)

  (* Funktionen die das Portieren von Fortran-Quellen unterstuetzen.        *)

  (*                                                                        *)

  (* Some Fortran intrinsics which can be used to translate Fortran to M2   *)

  (*------------------------------------------------------------------------*)

  (* Letzte Veraenderung:                                                   *)

  (*                                                                        *)

  (* 08.10.15, MRi: Erstellen der 1. Version                                *)

  (* 11.10.15, MRi: MIN0,MAX0 hinzugefuegt.                                 *)

  (* 05.05.16, MRi: Umbenennen von IntrinsicF77 nach F77func, REAL8,        *)

  (*                INTEGER4 eingefuehrt.                                   *)

  (* 28.08.16, MRi: D1Mach hinzugefuegt                                     *)

  (* 08.07.18, MRi: IAND, IOR & IEOR hinzugefuegt                           *)

  (*------------------------------------------------------------------------*)

  (* Offene Punkte:                                                         *)

  (*                                                                        *)

  (* - Erweiterung um andere Funktionen                                     *)

  (*------------------------------------------------------------------------*)

  (* Implementation : Michael Riedl                                         *)

  (* Licence        : GNU Lesser General Public License (LGPL)              *)

  (*------------------------------------------------------------------------*)



  (* $Id: F77func.mod,v 1.3 2017/07/24 08:47:58 mriedl Exp mriedl $ *)



FROM SYSTEM   IMPORT CAST;

FROM Errors   IMPORT ErrOut;

              IMPORT LowLong;

FROM LMathLib IMPORT MachEps;

FROM LongMath IMPORT ln,power;



PROCEDURE DSIGN(a,b : REAL8) : REAL8;



BEGIN

      (* RETURN LowLong.sign(b)*ABS(a); *)

      IF (b >= 0.0) THEN

        RETURN   ABS(a);

      ELSE

        RETURN - ABS(a);

      END;

END DSIGN;



PROCEDURE DMAX(x,y : REAL8) : REAL8;



BEGIN

      IF (x > y) THEN RETURN x ELSE RETURN y; END;

END DMAX;



PROCEDURE DMIN(x,y : REAL8) : REAL8;



BEGIN

      IF (x > y) THEN RETURN y; ELSE RETURN x; END;

END DMIN;



PROCEDURE MIN0(ix,iy : INTEGER4) : INTEGER4;



BEGIN

     IF (ix > iy) THEN RETURN iy ELSE RETURN ix; END;

END MIN0;



PROCEDURE MAX0(ix,iy : INTEGER4) : INTEGER4;



BEGIN

     IF (ix < iy) THEN RETURN iy ELSE RETURN ix; END;

END MAX0;



PROCEDURE DINT(x : REAL8) : REAL8;



BEGIN

      RETURN LowLong.intpart(x); 

END DINT;



PROCEDURE IAND(a,b : INTEGER) : INTEGER;



BEGIN

      RETURN VAL(INTEGER,(CAST(BITSET,a) * CAST(BITSET,b)));

END IAND;



PROCEDURE IOR(a,b : INTEGER) : INTEGER;



BEGIN

      RETURN VAL(INTEGER,(CAST(BITSET,a) + CAST(BITSET,b)));

END IOR;



PROCEDURE IEOR(a,b : INTEGER) : INTEGER;



BEGIN

      RETURN VAL(INTEGER,(CAST(BITSET,a) / CAST(BITSET,b)));

END IEOR;



PROCEDURE D1Mach(i : INTEGER): LONGREAL;



          VAR D1Mach    : LONGREAL;

              b         : LONGREAL;

              ExpDigits : INTEGER;

BEGIN

     b:=VAL(LONGREAL,LowLong.radix);

     ExpDigits:=VAL(CARDINAL,ln(VAL(LONGREAL,LowLong.expoMax+1)) / ln(2.0));



     (* TIO.WrStr("ExpDigits = "); TIO.WrCard(ExpDigits,3); TIO.WrLn; *)



     IF    (i = 1) THEN (* the smallest positive magnitude. *)

       D1Mach:=power(b,VAL(LONGREAL,LowLong.expoMin)); 

     ELSIF (i = 2) THEN

       D1Mach:=MAX(LONGREAL); (* the largest magnitude. *)

     ELSIF (i = 3) THEN (* the smallest relative spacing. *)

       D1Mach:=power(b,VAL(LONGREAL,  -(LowLong.places - ExpDigits - 1))); 

     ELSIF (i = 4) THEN (* the largest relative spacing. *)

       D1Mach:=power(b,VAL(LONGREAL,(1-(LowLong.places - ExpDigits - 1)))); 

     ELSIF (i = 5) THEN

       D1Mach:=MachEps;

     ELSIF (i = 6) THEN

       D1Mach:=LowLong.succ(1.0) - 1.0;

     ELSE

       ErrOut("Falsches Argument von D1Mach.");

       HALT;

     END;

     RETURN D1Mach;

END D1Mach;



END F77func.