code 41005;
real procedure HYPERGINV(PROB, N, R, M, LEFT);
value PROB, N, R, M, LEFT;
real PROB, N, R, M; Boolean LEFT;
begin integer X; real PX, PCUM, LOW, UP;

    if PROB ≤ 0 ∨ PROB ≥ 1 then
    STATAL3 ERROR(“HYPERGINV”, 1, PROB) else
    if N > ENTIER(N) ∨ N < 0 ∨ N > M then
    STATAL3 ERROR(“HYPERGINV”, 2, N) else
    if R > ENTIER(R) ∨ R < 0 ∨ R > M then
    STATAL3 ERROR(“HYPERGINV”, 3, R) else
    if M > ENTIER(M) ∨ M < 0 then
    STATAL3 ERROR(“HYPERGINV”, 4, M);
    LOW:= if N + R - M > 0 then N + R - M else 0;
    UP:= if N < R then N else R;
    if N = 0 ∨ R = 0 then
        HYPERGINV:= (if LEFT then -1 else +1)
    else if N = M ∨ R = M then
        HYPERGINV:= (if LEFT then M - 1 else M + 1)
    else if LEFT then
    begin X:= PHINV(PROB) × SQRT((M - N) × N × R ×
        (M - R) / (M × M × (M - 1))) + R × N / M + 0.5;
        if X < LOW then X:= LOW else
        if X > UP then X:= UP;
        if PROB < HYPERGPROB(LOW, N, R, M) then
            HYPERGINV:= LOW - 1
        else
        begin PX:= HYPERGPROB(X, N, R, M);
            PCUM:= HYPERG(X, N, R, M);
            if PCUM > PROB then
            begin for PCUM:= PCUM - PX
                    while PCUM > PROB do
                begin PX:= PX × X × (M - N - R + X) /
                     (N - X + 1) / (R - X + 1); X:= X - 1
                end; X:= X - 1
            end else
            begin for PX:= PX × (N - X) × (R - X) /
                (X + 1) / (R - X + 1)
                while PCUM + PX < PROB do
                begin X:= X + 1; PCUM:= PCUM + PX end
            end;
            HYPERGINV:= X
        end
    end else
    begin X:= PHINV(1 - PROB) × SQRT((M - N) × N × R ×
        (M - R) / (M × M × (M - 1))) + R × N / M - 0.5;
        if X < LOW then X:= LOW else
        if X > UP then X:= UP;
        if PROB < HYPERGPROB(UP, N, R, M) then
            HYPERGINV:= UP + 1
        else
        begin PCUM:= 1 - HYPERG(X - 1, N, R, M);
            PX:= HYPERGPROB(X, N, R, M);
            if PCUM < PROB then
            begin for PX:= PX × X × (M - N - R + X) /
                (N - X + 1) / (R - X + 1)
                while PCUM + PX < PROB do
                begin X:= X - 1; PCUM:= PCUM + PX end
            end else
            begin for PCUM:= PCUM - PX
                while PCUM > PROB do
                begin PX:= PX × (N - X) × (R - X) /
                    (X + 1) / (M - N - R + X + 1);
                    X:= X + 1
                end; X:= X + 1
            end;
            HYPERGINV:= X
        end
    end
end HYPERGINV;
eop