intros n1 n2 H H0 H1.
case H1; intros ny (ey, (H2, H3)).
case (Zle_or_lt 0 ey); intros Zl1.
case (Zle_or_lt ey precision); intros Zl2.
exists ny; exists ey; repeat (split; auto).
exists (ny * Zpower_nat radix (Zabs_nat (ey - precision)))%Z;
exists (Z_of_nat precision); repeat (split; auto with zarith).
replace (IZR (ny * Zpower_nat radix (Zabs_nat (ey - precision)))) with
(ny * powerRZ radix (ey - precision))%R.
rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with zarith real.
replace (ey - precision + precision)%Z with ey; [ auto | ring ].
rewrite Rmult_IZR.
rewrite Zpower_nat_powerRZ_absolu; auto with real zarith.
rewrite Zabs_Zmult.
apply lt_IZR; apply Rmult_lt_reg_l with (r := powerRZ radix precision);
auto with real zarith.
repeat rewrite (fun x y => Rmult_comm (powerRZ x y)).
rewrite Rmult_IZR.
rewrite Rmult_assoc.
rewrite (Zabs_eq (Zpower_nat radix (Zabs_nat (ey - precision))));
auto with zarith.
rewrite Zpower_nat_powerRZ_absolu; auto with real zarith.
rewrite <- powerRZ_add; auto with real zarith.
replace (ey - precision + precision)%Z with ey; [ idtac | ring ].
replace (powerRZ radix precision) with (IZR (Zpos (vNum b)));
[ idtac
| rewrite pGivesBound; rewrite <- Zpower_nat_powerRZ_absolu;
try rewrite absolu_INR; auto with zarith ].
rewrite <- (fun x y => Rabs_pos_eq (powerRZ x y)); auto with real zarith.
rewrite <- Faux.Rabsolu_Zabs; rewrite <- Rabs_mult; rewrite <- H2.
rewrite Rabs_mult; repeat rewrite Faux.Rabsolu_Zabs; auto with real zarith.
case (Zle_lt_or_eq 0 (Zabs n2)); auto with zarith; intros Z1.
apply Rlt_trans with (Zpos (vNum b) * Zabs n2)%R;
auto with real zarith.
rewrite <- Z1; auto with real zarith.
replace (Zabs n1 * 0%Z)%R with (0 * Zpos (vNum b))%R;
[ auto with real zarith | simpl; ring ].
exists (n1 * n2)%Z; exists 0%Z; repeat (split; auto with zarith).
rewrite Rmult_IZR; rewrite powerRZ_O; ring.
apply lt_IZR.
rewrite <- Faux.Rabsolu_Zabs; rewrite Rmult_IZR; rewrite H2.
rewrite Rabs_mult.
apply Rle_lt_trans with (Rabs ny).
pattern (Rabs ny) at 2 in |- *; replace (Rabs ny) with (Rabs ny * 1)%R;
[ apply Rmult_le_compat_l | ring ]; auto with arith real.
rewrite (Rabs_pos_eq (powerRZ radix ey));
[ idtac | apply powerRZ_le; auto with arith real ].
replace 1%R with (powerRZ radix 0); [ apply Rle_powerRZ | simpl in |- * ];
auto with real arith zarith.
rewrite Faux.Rabsolu_Zabs; auto with real zarith.
Qed.

(* Specifications: *)
Theorem errorBoundedMultExpPos :
forall P,
RoundedModeP b radix P ->
forall p q pq : float,
Fbounded b p ->
Fbounded b q ->
(0 <= p)%R ->
(0 <= q)%R ->
P (p * q)%R pq ->
(- dExp b <= Fexp p + Fexp q)%Z ->
ex
(fun r : float =>
ex
(fun s : float =>
Fbounded b r /\
Fbounded b s /\
r = pq :>R /\
s = (p * q - r)%R :>R /\
Fexp s = (Fexp p + Fexp q)%Z :>Z /\
(Fexp s <= Fexp r)%Z /\ (Fexp r <= precision + (Fexp p + Fexp q))%Z)).