IMPLEMENTATION MODULE SUPRAND; FROM SUPINT IMPORT Base, SuperInteger, InfoSuperInteger, TwoExp, Create, Affect; FROM SUPARITH IMPORT Add, Subtract; VAR Cg1, Cg2 : LONGINT; (* Etat du generateur. *) BaseMoinsUn : REAL; Y : SuperInteger; (******************************************************************************) PROCEDURE SetSeed ( S1, S2 : LONGINT ); BEGIN Cg1 := S1; Cg2 := S2 END SetSeed ; (******************************************************************************) PROCEDURE GetState ( VAR S1, S2 : LONGINT ); BEGIN S1 := Cg1; S2 := Cg2 END GetState; (******************************************************************************) PROCEDURE Uniform01 () : REAL; (* Procedure non publique qui retourne un reel selon une loi uniforme *) (* entre 0 et 1. *) VAR Z, k, s1, s2 : LONGINT; BEGIN s1 := Cg1; s2 := Cg2; k := s1 DIV 53668; s1 := 40014 * (s1 - k * 53668) - k * 12211; IF s1 < 0 THEN INC ( s1, 2147483563 ) END; k := s2 DIV 52774; s2 := 40692 * (s2 - k * 52774) - k * 3791; IF s2 < 0 THEN INC ( s2, 2147483399 ) END; Cg1 := s1; Cg2 := s2; Z := s1 - s2; IF Z < 1 THEN INC ( Z, 2147483562 ) END; RETURN FLOAT (Z) * 4.656613E-10 END Uniform01; (******************************************************************************) PROCEDURE SupRandom ( A, B, C : SuperInteger ); VAR I, J : INTEGER; BEGIN Subtract ( B, A, C ); WITH Y^ DO SigPos := C^.SigPos; IF TwoExp [Power] <= SigPos THEN Affect ( C, Y ) END; Negative := FALSE; LOOP I := SigPos; Digit^[I] := VAL (LONGINT, TRUNC (FLOAT (C^.Digit^[I]) * Uniform01 () + 0.5)); WHILE ( Digit^[I] = C^.Digit^[I] ) AND ( I > 0 ) DO DEC (I); Digit^[I] := VAL (LONGINT, TRUNC (BaseMoinsUn * Uniform01 () + 0.5)); END; IF Digit^[I] <= C^.Digit^[I] THEN DEC (I); FOR J := I TO 0 BY -1 DO Digit^[J] := VAL (LONGINT, TRUNC (BaseMoinsUn * Uniform01 () + 0.5)); END; EXIT END END; WHILE (Digit^[SigPos] = 0) AND (SigPos # 0) DO DEC ( SigPos ) END; Add ( A, Y, C ) END; IF C^.Digit^[C^.SigPos] = 0 THEN C^.Negative := FALSE END; (* ajout de JT pour eviter -zero *) END SupRandom; (******************************************************************************) BEGIN BaseMoinsUn := FLOAT (Base - 1); SetSeed (1234567890, 123456789); Create (Y, 6) END SUPRAND.