|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Ran1_Package, seg_005382
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Unchecked_Deallocation;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
package body Ran1_Package is
------------------------------------------------------------------------------
-- Ran1 returns a uniform random deviate between 0.0 and 1.0. Uses linear
-- congruential methods using three portable not-as-good random number
-- generators. Near infinite period with no sensible sequential correlation.
--
-- Based upon: Ran1, pg 196;
-- Numerical Recipes: The Art Of Scientific Computing
-- W. H. Press, B. P. Flannery, S. A. Teukolsky, W. T. Vetterling
-- Cambridge University Press, 1986
------------------------------------------------------------------------------
type Float_Array is array (S_Natural range <>) of Float;
M1 : constant := 259200;
Ia1 : constant := 7141;
Ic1 : constant := 54773;
Rm1 : constant Float := 1.0 / Float (M1);
M2 : constant := 134456;
Ia2 : constant := 8121;
Ic2 : constant := 28411;
Rm2 : constant Float := 1.0 / Float (M2);
M3 : constant := 243000;
Ia3 : constant := 4561;
Ic3 : constant := 51349;
type Ran1_Data_Rec is
record
Ix1 : S_Natural;
Ix2 : S_Natural;
Ix3 : S_Natural;
R : Float_Array (1 .. 97);
end record;
procedure Free_Ran1_Data is new Unchecked_Deallocation (Ran1_Data_Rec,
Ran1_Data);
--\x0c
function Ran1_Initialize (Iseed : S_Natural) return Ran1_Data is
------------------------------------------------------------------------------
-- Iseed - Specifies the initial seed value to be passed to the RAN()
-- during our initialization.
-- Called to create and initialize a Ran1_Data area for use with Ran1.
------------------------------------------------------------------------------
Data : Ran1_Data := new Ran1_Data_Rec;
begin
----Seed the first generator.
Data.Ix1 := (Ic1 - Iseed) mod M1;
Data.Ix1 := (Ia1 * Data.Ix1 + Ic1) mod M1;
----Use the first to seed the second and third.
Data.Ix2 := Data.Ix1 mod M2;
Data.Ix1 := (Ia1 * Data.Ix1 + Ic1) mod M1;
Data.Ix3 := Data.Ix1 mod M3;
----Fill the table with sequential uniform deviates generated by the first two
-- generators.
for I in Data.R'Range loop
Data.Ix1 := (Ia1 * Data.Ix1 + Ic1) mod M1;
Data.Ix2 := (Ia2 * Data.Ix2 + Ic2) mod M2;
Data.R (I) := (Float (Data.Ix1) + Float (Data.Ix2) * Rm2) * Rm1;
end loop;
return Data;
end Ran1_Initialize;
--\x0c
procedure Ran1_Free (Idum : in out Ran1_Data) is
------------------------------------------------------------------------------
-- Idum - Specifies the data area to free.
-- Called to free up the Ran1_Data area allocated by Ran1_Initialize. It is
-- OK to call this with a null.
------------------------------------------------------------------------------
begin
Free_Ran1_Data (Idum);
end Ran1_Free;
--\x0c
function Ran1 (Idum : Ran1_Data) return Float is
------------------------------------------------------------------------------
-- Idum - Specifies the Ran1_Data to use in calculating the next random
-- value.
-- Called to calculate the next uniform random deviate between 0.0 and 1.0.
------------------------------------------------------------------------------
J : S_Long;
F : Float;
begin
Idum.Ix1 := (Ia1 * Idum.Ix1 + Ic1) mod M1;
Idum.Ix2 := (Ia2 * Idum.Ix2 + Ic2) mod M2;
Idum.Ix3 := (Ia3 * Idum.Ix3 + Ic3) mod M3;
J := 1 + (Idum.R'Last * Idum.Ix3) / M3;
if J > Idum.R'Last then
J := J - 1;
end if;
F := Idum.R (J);
Idum.R (J) := (Float (Idum.Ix1) + Float (Idum.Ix2) * Rm2) * Rm1;
return F;
end Ran1;
--\x0c
end Ran1_Package;
nblk1=8
nid=7
hdr6=e
[0x00] rec0=1b rec1=00 rec2=01 rec3=03a
[0x01] rec0=1a rec1=00 rec2=08 rec3=018
[0x02] rec0=01 rec1=00 rec2=02 rec3=004
[0x03] rec0=1d rec1=00 rec2=03 rec3=076
[0x04] rec0=00 rec1=00 rec2=06 rec3=008
[0x05] rec0=1b rec1=00 rec2=04 rec3=046
[0x06] rec0=08 rec1=00 rec2=05 rec3=000
[0x07] rec0=02 rec1=40 rec2=00 rec3=0c3
tail 0x217008920819788ea4898 0x42a00088462063203
Free Block Chain:
0x7: 0000 00 00 00 04 80 01 20 01 00 00 00 00 00 00 00 01 ┆ ┆