intervals 0.3.56

data/ext/crlibm/exp_accurate.c

@@ -0,0 +1,197 @@
+/*
+ * Correctly rounded exponential
+ *
+ * Author : David Defour
+ *
+ * This file is part of the crlibm library developed by the Arenaire
+ * project at Ecole Normale Superieure de Lyon
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or 
+ * (at your option) any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include "crlibm.h"
+#include "crlibm_private.h"
+#include "exp_accurate.h"
+
+
+/***********************************************************/
+/*                      Second step                         */
+/***********************************************************/
+
+
+
+/** 
+ * We use the Brent formula to evaluate exp(x)
+ *
+ *  1) Step 1 : range reduction
+ *
+ *        x  -  k * ln(2)         -ln(2)        +ln(2) 
+ *  r = ---------------------     ------ <  r < ------ 
+ *             512                 1024          1024
+ *
+ *                            (512)      (k)
+ *   so that exp(x) = exp(r)^       * 2^
+ *
+ *
+ *  2) Step 2 : polynomial evaluation
+ *
+ *                      2        3        4        5
+ *  exp(r) ~ (1 + r + r^ /2! + r^ /3! + r^ /4! + r^ /5!
+ *                      6        7        8        9  
+ *                  + r^ /6! + r^ /7! + r^ /8! + r^ /9! 
+ *                      10          11 
+ *                  + r^  /10!  + r^  /11! )*(1+err)
+ *
+ *                  (-164)
+ *  where |err| < 2^ 
+ *
+ *
+ *  3) Step 3 : compute exp(r) to the power of 512
+ *
+ *          (512)                 2   2   2   2   2   2   2   2   2
+ *   exp(r)^     = ((((((((exp(r)^  )^  )^  )^  )^  )^  )^  )^  )^
+ *
+ *
+ *
+ *  4) Step 4 : reconstruction
+ *
+ *                            (512)      (k)
+ *            exp(x) = exp(r)^       * 2^
+ *   
+ *
+ * Take an scs number as input and give the exponential of x
+ * exactly rounded to nearest.
+ *
+ * Notes:
+ *  - Flags need to be set to round to nearest
+ */
+
+void exp_SC(scs_ptr res_scs, double x){
+  scs_t sc1, red, red_low;
+  db_number db;
+  int i, k;
+
+
+  /* db.d = x/512  (= 2^9)  */
+  
+  db.d = x;                                  
+  db.i[HI] -= (9 << 20);              
+  scs_set_d(sc1, db.d);                      
+  
+  
+  DOUBLE2INT(k, (db.d * iln2_o512.d));       
+ 
+  /* 1) R�duction d'argument */
+
+  scs_set(red,     sc_ln2_o512_1_ptr);             
+  scs_set(red_low, sc_ln2_o512_2_ptr);             
+  if (k>0){
+    scs_mul_ui(red,      (unsigned int) k);
+    scs_mul_ui(red_low,  (unsigned int) k);
+  }else {
+    scs_mul_ui(red,      (unsigned int)(-k));
+    scs_mul_ui(red_low,  (unsigned int)(-k));
+    red->sign *= -1;
+    red_low->sign *=-1;
+  }                
+
+  scs_sub(red, sc1, red);                    
+  scs_sub(red, red, red_low);                    
+
+  
+  /* 2) Evaluation polynomiale */            
+   
+  scs_mul(res_scs, constant_poly_ptr[0], red);
+  for(i=1; i< 10; i++){                       
+    scs_add(res_scs, constant_poly_ptr[i], res_scs);
+    scs_mul(res_scs, red, res_scs);            
+  }
+  
+  scs_add(res_scs, SCS_ONE, res_scs);  
+  scs_mul(res_scs, red, res_scs);
+  scs_add(res_scs, SCS_ONE, res_scs);        
+
+  /* 3) Mise a la puissance exp(r)^512  */
+  for(i=0; i<9; i++)                        
+    scs_square(res_scs, res_scs);
+  
+
+  res_scs->index += (int)(k/30);
+  if ((k%30) > 0) 
+    scs_mul_ui(res_scs, (unsigned int) (1<<((k%30))));
+  else if ((k%30) < 0){
+    res_scs->index --;
+    scs_mul_ui(res_scs, (unsigned int) (1<<((30+(k%30)))));
+  }
+}
+
+
+
+/*************************************************************
+ *************************************************************
+ *               ROUNDED  TO NEAREST		             *
+ *************************************************************
+ *************************************************************/
+double scs_exp_rn(double x){ 
+  scs_t res_scs;
+  db_number res;
+  
+#if EVAL_PERF==1
+  crlibm_second_step_taken++;
+/*   printf("second step taken"); */
+#endif
+
+
+  /* 4) Reconstruction */
+
+  exp_SC(res_scs, x);
+  scs_get_d(&res.d, res_scs);
+
+  return res.d;
+}
+
+
+/*************************************************************
+ *************************************************************
+ *               ROUNDED  TOWARD  -INFINITY		     *
+ *************************************************************
+ *************************************************************/
+double scs_exp_rd(double x){ 
+  scs_t res_scs;
+  db_number res;
+  
+  exp_SC(res_scs, x);
+  scs_get_d_minf(&res.d, res_scs);
+
+  return res.d;
+}
+
+
+/*************************************************************
+ *************************************************************
+ *               ROUNDED  TOWARD  +INFINITY		     *
+ *************************************************************
+ *************************************************************/
+double scs_exp_ru(double x){ 
+  scs_t res_scs;
+  db_number res;
+  
+  exp_SC(res_scs, x);
+  scs_get_d_pinf(&res.d, res_scs);
+  
+  return res.d;
+}
+

data/ext/crlibm/exp_accurate.h

@@ -0,0 +1,85 @@
+
+
+
+/***********************************************************/
+/*                      Second step                        */
+/***********************************************************/
+
+#ifdef WORDS_BIGENDIAN
+static const db_number 
+  iln2_o512 = {{0x40871547, 0x652B82FE}}; /* 512/ln(2)        */
+#else
+static const db_number 
+  iln2_o512 = {{0x652B82FE, 0x40871547}}; /* 512/ln(2)        */
+#endif
+
+static const struct scs 
+sc_ln2_o512_1 = {{0x00162e42, 0x3fbe8e7b, 0x335793c7, 0x19cc01f9,
+		  0x1ed5e81e, 0x1a193394, 0x316c5b14, 0x00000000},
+		 DB_ONE,  -1,   1 },
+sc_ln2_o512_2 = {{0x068badc5, 0x355f457c, 0x3dc3b103, 0x1bd75930, 
+		  0x2acaa97d, 0x295f4362, 0x07697571, 0x2b827042},
+		 DB_ONE,  -8,   1 };
+
+#define sc_ln2_o512_1_ptr ((scs_ptr)(&sc_ln2_o512_1))
+#define sc_ln2_o512_2_ptr ((scs_ptr)(&sc_ln2_o512_2))
+
+
+/* We should add 1+x to this polynom and multiply it by x^2 */
+static const scs constant_poly[10]=  		/* 2^-164 */
+/* ~2.505211e-08 */ 
+{{{0x0000001a, 0x39915ae6, 0x271b3b26, 0x3bc3c8d6, 
+0x327f2894, 0x1a80bba6, 0x2d7be149, 0x149ab262},
+DB_ONE,  -1,   1 } 
+,
+/* ~2.755732e-07 */ 
+{{0x00000127, 0x393ee8a7, 0x2647a705, 0x037af958, 
+0x0c753fb3, 0x0941e129, 0x13162578, 0x1773558f},
+DB_ONE,  -1,   1 } 
+,
+/* ~2.755732e-06 */ 
+{{0x00000b8e, 0x3c74aad8, 0x399abcfd, 0x1225e04b, 
+0x2e8dea13, 0x038b8517, 0x3212cece, 0x2cb577c5},
+DB_ONE,  -1,   1 } 
+,
+/* ~2.480159e-05 */ 
+{{0x00006806, 0x201a01a0, 0x066e4bb6, 0x156666d6, 
+0x333d1ab0, 0x06772281, 0x044e4578, 0x04d8d60d},
+DB_ONE,  -1,   1 } 
+,
+/* ~1.984127e-04 */ 
+{{0x00034034, 0x00d00d00, 0x34034034, 0x0249047b, 
+0x38e5a9d7, 0x30805847, 0x335f9062, 0x206ba2e1},
+DB_ONE,  -1,   1 } 
+,
+/* ~1.388889e-03 */ 
+{{0x0016c16c, 0x05b05b05, 0x2c16c16c, 0x121e8acb, 
+0x25da960e, 0x2999616d, 0x2b3ae80c, 0x1a17471d},
+DB_ONE,  -1,   1 } 
+,
+/* ~8.333333e-03 */ 
+{{0x00888888, 0x22222222, 0x08888888, 0x22222220, 
+0x072a661e, 0x15f0a5cf, 0x3fc53e81, 0x3da68844},
+DB_ONE,  -1,   1 } 
+,
+/* ~4.166667e-02 */ 
+{{0x02aaaaaa, 0x2aaaaaaa, 0x2aaaaaaa, 0x2aaaaa9e, 
+0x2e389977, 0x07fcaf81, 0x07fee303, 0x13eab39c},
+DB_ONE,  -1,   1 } 
+,
+/* ~1.666667e-01 */ 
+{{0x0aaaaaaa, 0x2aaaaaaa, 0x2aaaaaaa, 0x2aaaaaaa, 
+0x2aaaaadc, 0x1902174f, 0x32f46829, 0x13f2855b},
+DB_ONE,  -1,   1 } 
+,
+/* ~5.000000e-01 */ 
+{{0x20000000, 0x00000000, 0x00000000, 0x00000000, 
+0x00000075, 0x21e5e9c2, 0x1e95e039, 0x17dad7b5},
+DB_ONE,  -1,   1 } 
+};
+
+
+#define constant_poly_ptr (scs_ptr)&constant_poly
+
+
+

data/ext/crlibm/gappa/log-de-E0-logir0.gappa

@@ -0,0 +1,106 @@
+# Usage: You need to set the constants. Running the log-de.mpl Maple script
+# should create the required sed files.  The command to run is 
+#  sed -f  TEMPLOG/log-de_0.sed log-de-E0-logir0.gappa | gappa > /dev/null
+
+# NOTATION CONVENTION 
+# Variables that correspond to double-precision variables in the code begin with a small letter
+# Other variables begin with a capital letter.
+# Variables that will be replaced with Maple-computed constants begin with an underscore
+# Otherwise avoid underscores as they are painful to carry on to LaTeX :)
+
+# polynomial coefficients, computed by Maple
+c1 = <float64ne>(_c1);
+c2 = <float64ne>(_c2);
+c3 = <float64ne>(_c3);
+c4 = <float64ne>(_c4);
+c5 = <float64ne>(_c5);
+c6 = <float64ne>(_c6);
+c7 = <float64ne>(_c7);
+log2h  = <float64ne>(_log2h);
+log2l  = <float64ne>(_log2l);
+
+# Transcription of the code, NOT using FMA
+z2  <float80ne>= z*z;    
+p67 <float80ne>= c6 + z*c7;       
+p45 <float80ne>= c4 + z*c5;      
+p23 <float80ne>= c2 + z*c3;    
+z4  <float80ne>= z2*z2;  
+p47 <float80ne>= p45 + z2*p67;    
+p03 <float80ne>= z + z2*p23; 
+log <float80ne>= p03 + z4*p47;
+
+
+# Give the polynomial in Estrin form (no need to transcribe the intermediate steps)
+# Since the argument reduction is exact, z=Z.
+Z2 = z*z;
+Z4 = Z2*Z2;
+Z3 = z*z*z; # to lighten the hints
+
+P23 = (c2+z*c3);
+P47 = (c4 + z*c5) + Z2*(c6 + z*c7);
+P03 = z + Z2*P23;
+AP03    = z + Z2*p23;
+AP03R0  = z + z2*p23;
+AP03R1  = z+<float80ne>(z2*p23);
+# AP03R2 = p03
+
+PolyLog1pz = P03  + Z4*P47  ;
+
+# PolyLog1pz = P03 + Z4*P47,   with the differential between p47 and P47 managed below
+LogR = p03 + Z4*p47;
+LogR0 = p03 + z4*p47;
+LogR1 = p03 + <float80ne>(z4*p47);
+# LogR2 = log
+
+{
+    z in [-_zmax, _zmax] 
+/\  (PolyLog1pz - Log)/Log in [-_epsilonApproxQuick, _epsilonApproxQuick]
+
+->
+
+(log - Log)/Log in  [-1b-61, 1b-61]
+}
+
+#  the obvious decomposition of (log-Log)/Log:
+(log-Log)/Log -> (log - PolyLog1pz)/PolyLog1pz + (PolyLog1pz - Log)/Log   +   ((log - PolyLog1pz)/PolyLog1pz) * ((PolyLog1pz - Log)/Log);
+
+# Intermediate steps for epsilon(log,PolyLog1pz) 
+(log - PolyLog1pz)/PolyLog1pz   -> (log-LogR1)/LogR1 + (LogR1 - PolyLog1pz)/PolyLog1pz + ((log-LogR1)/LogR1)* ((LogR1 - PolyLog1pz)/PolyLog1pz);
+(LogR1 - PolyLog1pz)/PolyLog1pz -> (LogR1- LogR0)/LogR0 + (LogR0 - PolyLog1pz)/PolyLog1pz + ((LogR1- LogR0)/LogR0) * ((LogR0 - PolyLog1pz)/PolyLog1pz);
+(LogR0 - PolyLog1pz)/PolyLog1pz -> (LogR0 -LogR)/LogR  + (LogR - PolyLog1pz)/PolyLog1pz + ((LogR0 -LogR)/LogR)*((LogR - PolyLog1pz)/PolyLog1pz);
+
+# First we need to get an error of p03 (I think. There may well be a shorter path to a proof)
+
+# layers of approx
+(p03 - P03)/P03 -> (p03 - AP03)/AP03 + (AP03-P03)/P03 + ((p03 - AP03)/AP03) * ((AP03-P03)/P03);
+(p03 - AP03)/AP03 -> (p03 - AP03R1)/AP03R1 + (AP03R1 - AP03)/AP03 +    ((p03 - AP03R1)/AP03R1) * ((AP03R1 - AP03)/AP03) ;
+(AP03R1 - AP03)/AP03 -> (AP03R1 - AP03R0)/AP03R0 + (AP03R0 - AP03)/AP03 + ((AP03R1 - AP03R0)/AP03R0)*((AP03R0 - AP03)/AP03) ;
+
+(AP03-P03)/P03 -> z*(p23-P23)/(1+z*P23);
+
+# Now all the trick is to factor z, so as to divide by (1+epsilon) 
+#(AP03R1 - AP03R0)/AP03R0 ->  ( (z*p23) * ((<float80ne>(z2*p23) - (z2*p23))/ (z2*p23)) ) / (1 + (z2/z)*p23)    ;
+(AP03R1 - AP03R0)/AP03R0  -> ((<float80ne>(z2*p23) -  (z2*p23))/z)  / (1 + (z2/z)*p23) ;
+(<float80ne>(z2*p23) -  (z2*p23))/z -> ((<float80ne>(z2*p23) -  (z2*p23))/(z2*p23)) *  (z2/z) * p23;
+z2/z -> z*((z2-Z2)/Z2) + z;
+
+(AP03R0 - AP03)/AP03 -> z*(((z2-Z2)/Z2)*p23) / (1 + z*p23);
+
+#                         -----------rounding error--------------           ---- small ---
+(LogR1 - LogR0)/LogR0 -> ((<float80ne>(z4*p47) - z4*p47)/(z4*p47)) * p47 * (z4/(p03+z4*p47)); 
+# Now please Gappa remark that (z4/(p03+z4*p47)) is small 
+z4/(p03+z4*p47) -> (z4/Z4) * (Z4 / (p03+z4*p47));
+z4/Z4 -> (z4-Z4)/Z4 + 1;
+Z4 / (p03+z4*p47) -> Z3/(p03/z + (z4/z) * p47);
+z4/z -> Z3* (z4/Z4);
+p03/z -> (p03/P03) * (P03/z);
+p03/P03 -> (p03 - P03)/P03 + 1;
+P03/z -> 1 + z*P23;
+
+(LogR0 - LogR)/LogR -> ((z4-Z4)/z)*p47 / (p03/z + Z3*p47); 
+(z4-Z4)/z -> ((z4-Z4) / Z4) * Z3;
+
+
+(LogR - PolyLog1pz)/PolyLog1pz -> ((p03-P03)/z + Z3*(p47-P47)) / (P03/z + Z3*P47);
+(p03-P03)/z -> ((p03-P03)/P03) * (P03/z); 
+

data/ext/crlibm/gappa/log-de-E0.gappa

@@ -0,0 +1,79 @@
+# Usage: You need to set the constants. Running the log-de.mpl Maple script
+# should create the required sed files and give the command to run.
+
+# NOTATION CONVENTION 
+# Variables that correspond to double-precision variables in the code begin with a small letter
+# Other variables begin with a capital letter.
+# Variables that will be replaced with Maple-computed constants begin with an underscore
+# Otherwise avoid underscores as they are painful to carry on to LaTeX :)
+
+# polynomial coefficients, computed by Maple
+c1 = <float64ne>(_c1);
+c2 = <float64ne>(_c2);
+c3 = <float64ne>(_c3);
+c4 = <float64ne>(_c4);
+c5 = <float64ne>(_c5);
+c6 = <float64ne>(_c6);
+c7 = <float64ne>(_c7);
+log2h  = <float64ne>(_log2h);
+log2l  = <float64ne>(_log2l);
+r     = <float64ne>(_r);
+logirh = <float64ne>(_logirh);
+logirl = <float64ne>(_logirl);
+
+
+# Transcription of the code, NOT using FMA
+z2  <float80ne>= z*z;    
+p67 <float80ne>= c6 + z*c7;       
+p45 <float80ne>= c4 + z*c5;      
+p23 <float80ne>= c2 + z*c3;    
+p01 <float80ne>= logirh + z;
+z4  <float80ne>= z2*z2;  
+p47 <float80ne>= p45 + z2*p67;    
+p03 <float80ne>= p01 + z2*p23; 
+log <float80ne>= p03 + z4*p47;
+
+# Exact mathematical definition of the log
+Log = Log1pz + Logir;
+
+#############   Now come auxiliary definitions
+
+# Give the polynomial in Estrin form (no need to transcribe the intermediate steps)
+# Since the argument reduction is exact, z=Z.
+Z2 = z*z;
+Z4 = Z2*Z2;
+ALog  =  ( (logirh+z) + Z2*(c2+z*c3) )     + Z4*( (c4+z*c5) + Z2*(c6+z*c7)  ); 
+
+# Useless definition, except for debugging the proof
+P07R =  ( (logirh+z) + z2*(c2+z*c3) )     + z4*( (c4+z*c5) + z2*(c6+z*c7)  ); 
+
+
+
+PolyLog1pz = z + Z2*(c2+z*c3) + Z4*( (c4+z*c5) + Z2*(c6+z*c7)  );
+
+
+{
+    z in [-_zmax, _zmax] 
+/\  (logirh + logirl) - Logir in [-1b-129, 1b-129]
+/\  (PolyLog1pz - Log1pz)/Log1pz in [-_epsilonApproxQuick, _epsilonApproxQuick]
+/\  (PolyLog1pz - Log1pz) in [-_deltaApproxQuick, _deltaApproxQuick]
+->
+(log - Log)/Log in [-1b-61, 1b-61]
+}
+
+
+
+
+# Trivialities
+Log2  -> (log2h + log2l) - ((log2h + log2l) - Log2);
+Logir -> (logirh + logirl) - ((logirh + logirl) -Logir);
+Log1pz -> PolyLog1pz - (PolyLog1pz - Log1pz);
+
+(logirh-Logir) ->  ((logirh + logirl) - Logir) - logirl;
+
+(log-Log)/Log -> (log - ALog)/ALog + (ALog - Log)/Log   +   ((log - ALog)/ALog) * ((ALog - Log)/Log);
+
+# A complex rule obtained by substituting by hand the definitions of ALog and Log until they could be usefully aligned.
+ALog - Log ->  (logirh-Logir) + (PolyLog1pz  - Log1pz) ;
+(ALog - Log)/Log ->  (logirh-Logir)/Logir + (PolyLog1pz  - Log1pz)/Log1pz    +    ((logirh-Logir)/Logir) * ((PolyLog1pz  - Log1pz)/Log1pz) ;
+

data/ext/crlibm/gappa/log-de.gappa

@@ -0,0 +1,81 @@
+# Usage: You need to set the constants. Running the log-de.mpl Maple script
+# should create the required sed files and give the command to run.
+
+# NOTATION CONVENTION 
+# Variables that correspond to double-precision variables in the code begin with a small letter
+# Other variables begin with a capital letter.
+# Variables that will be replaced with Maple-computed constants begin with an underscore
+# Otherwise avoid underscores as they are painful to carry on to LaTeX :)
+
+# polynomial coefficients, computed by Maple
+c1 = <float64ne>(_c1);
+c2 = <float64ne>(_c2);
+c3 = <float64ne>(_c3);
+c4 = <float64ne>(_c4);
+c5 = <float64ne>(_c5);
+c6 = <float64ne>(_c6);
+c7 = <float64ne>(_c7);
+log2h = <float64ne>(_log2h);
+log2  = <float64ne>(_log2l);
+r     = <float64ne>(_r);
+logirh = <float64ne>(_logirh);
+logirl = <float64ne>(_logirl);
+
+E=1;  # TODO paper proof that E=1 is the worst case
+
+
+# Transcription of the code, NOT using FMA
+z2  <float80ne>= z*z;    
+p67 <float80ne>= c6 + z*c7;       
+p45 <float80ne>= c4 + z*c5;      
+p23 <float80ne>= c2 + z*c3;    
+p01 <float80ne>= logirh + z*c1;
+z4  <float80ne>= z2*z2;  
+p47 <float80ne>= p45 + z2*p67;    
+p03 <float80ne>= p01 + z2*p23; 
+p07 <float80ne>= p03 + z4*p47;
+log <float80ne>= p07 + E*log2h;
+
+# Exact mathematical definition of the log
+Log = Log1pz + Logir + E*Log2;
+
+#############   Now come auxiliary definitions
+
+# Give the polynomial in Estrin form (no need to transcribe the intermediate steps)
+# Since the argument reduction is exact, z=Z.
+Z2 = z*z;
+Z4 = Z2*Z2;
+P07  =  ( (logirh+z*c1) + Z2*(c2+z*c3) )     + Z4*( (c4+z*c5) + Z2*(c6+z*c7)  ); 
+
+# Useless definition, except for debugging the proof
+P07R =  ( (logirh+z*c1) + z2*(c2+z*c3) )     + z4*( (c4+z*c5) + z2*(c6+z*c7)  ); 
+
+ALog = P07 + E*Log2;
+
+
+PolyLog1pz = z*c1 + Z2*(c2+z*c3) + Z4*( (c4+z*c5) + Z2*(c6+z*c7)  );
+
+
+{
+    z in [-_zmax, _zmax] 
+/\  (log2h + log2l) - Log2    in [-1b-129, 1b-129]  # TODO give exact value, just for cleanness   
+/\  (logirh + logirl) - Logir in [-1b-129, 1b-129]  # idem. This is true but needs a proof out of Gappa
+#/\  (PolyLog1pz - Log1pz)/Log1pz in [-_epsilonApproxQuick, _epsilonApproxQuick]
+/\  (PolyLog1pz - Log1pz) in [-_deltaApproxQuick, _deltaApproxQuick]
+->
+(log - Log)/Log in ? # [-1b-62, 1b-62]
+/\ log-Log in ?
+/\ log in ?
+}
+
+
+# Trivialities
+Log2  -> (log2h + log2l) - ((log2h + log2l) - Log2);
+Logir -> logirh + ((logirl - (logirh +logirl -Logir)));
+Log   -> ALog - (ALog-Log);
+
+log - Log -> (log - ALog) + (ALog - Log);
+
+# A complex rule obtained by substituting by hand the definitions of ALog and Log until they could be usefully aligned.
+ALog - Log ->  (logirh-Logir) + (PolyLog1pz  - Log1pz) ;
+

data/ext/crlibm/gappa/log-td-E0-logir0.gappa

@@ -0,0 +1,126 @@
+
+c3 = <float64ne> (_c3);
+c4 = <float64ne> (_c4);
+c5 = <float64ne> (_c5);
+c6 = <float64ne> (_c6);
+c7 = <float64ne> (_c7);
+
+
+E = 0; #MAPLE
+
+zh = <float64ne> (Z);
+zl = Z - zh; #MAPLE
+
+polyHorner <float64ne>= c3 + zh * (c4 + zh * (c5 + zh * (c6 + zh * c7)));
+
+ZhSquarehl = zh * zh; #MAPLE
+zhSquareh = <float64ne> (ZhSquarehl);
+zhSquarel = <float64ne> (ZhSquarehl - zhSquareh);
+
+zhSquareHalfh = zhSquareh * (-0.5); #MAPLE
+zhSquareHalfl = zhSquarel * (-0.5); #MAPLE
+ZhSquareHalfhl = ZhSquarehl * (-0.5); #MAPLE
+
+ZhCube <float64ne>= (zh * zhSquareh);
+polyUpper <float64ne>= polyHorner * ZhCube;
+
+temp = <float64ne> (zh * zl);
+T1hl = polyUpper - temp; #MAPLE
+t1h = <float64ne> (T1hl);
+t1l = <float64ne> (T1hl - t1h);
+
+T2 = Z + ZhSquareHalfhl; #MAPLE
+t2h = <float64ne> (T2hl);
+t2l = <float64ne> (T2hl - t2h);
+
+PE = T2hl + T1hl; #MAPLE
+ph = <float64ne> (Phl);
+pl = <float64ne> (Phl - ph);
+
+
+#We can simplify the computations in the function in this case as we know that 
+#all operations (add, mult) on 0 (as a double double) are exact.
+
+Loghm = Phl; #MAPLE
+
+logh = <float64ne> (Loghm);
+logm = <float64ne> (Loghm - logh);
+
+#Mathematical definition of the logarithm and the polynomial
+
+Phigher = (c3 + Z * (c4 + Z * (c5 + Z * (c6 + Z * c7)))); #MAPLE
+ZZZ = Z*Z*Z; #MAPLE
+ZZZPhigher = ZZZ * Phigher; #MAPLE
+HZZ = (-0.5*Z*Z); #MAPLE
+ZpHZZ = Z + HZZ; #MAPLE
+P = ZpHZZ + ZZZPhigher; #MAPLE
+
+#We apply the same simplification on the mathematical definition of the log
+Log = Log1pZ; #MAPLE
+
+
+#Additional useful definitions
+
+ZZ = Z*Z; #MAPLE
+ZZZPhigherPzhzl = ZZZPhigher - zh * zl; #MAPLE
+
+HZ = -0.5*Z; #MAPLE
+
+Flzhzl = temp; #MAPLE
+
+{
+(T2hl - T2) / T2 in [-1b-103,1b-103]
+/\ (Phl - PE) / PE in [-1b-103,1b-103]
+/\ Z in [_zmin,_zmax]
+/\ (P - Log1pZ) / Log1pZ in [-_epsilonApproxQuick,_epsilonApproxQuick]
+/\ ((logh + logm) - Loghm) / Loghm in [-1b-106,1b-106]
+->
+((logh + logm) - Log) / Log in [-5b-65,5b-65]
+}
+
+T2hl - T2 -> ((T2hl - T2) / T2) * T2;
+T2hl -> (T2hl - T2) + T2;
+
+Phl - PE -> ((Phl - PE) / PE) * PE;
+Phl -> (Phl - PE) + PE;
+
+
+(ZhSquarehl - ZZ) / ZZ -> 2 * ((zh - Z) / Z) + ((zh - Z) / Z) * ((zh - Z) / Z);
+
+(zhSquareh - ZZ) / ZZ -> ((ZhSquarehl - ZZ) / ZZ) + ((zhSquareh - ZhSquarehl) / ZZ);
+
+(zhSquareh - ZhSquarehl) / ZZ -> ((zhSquareh - ZhSquarehl) / ZhSquarehl) * (ZhSquarehl / ZZ);
+
+ZhSquarehl / ZZ -> ((ZhSquarehl - ZZ) / ZZ) + 1;
+
+(ZhCube - ZZZ) / ZZZ -> (((zh * zhSquareh) - ZZZ) / ZZZ) + ((ZhCube - (zh * zhSquareh)) / ZZZ);
+
+((zh * zhSquareh) - ZZZ) / ZZZ -> (1 + ((zh - Z) / Z)) * (1 + ((zhSquareh - ZZ) / ZZ)) - 1;
+
+((ZhCube - (zh * zhSquareh)) / ZZZ) -> ((ZhCube - (zh * zhSquareh)) / (zh * zhSquareh)) * (((zh - Z) / Z) + 1) * (((zhSquareh - ZZ) / ZZ) + 1);
+
+polyHorner / Phigher -> ((polyHorner - Phigher) / Phigher) + 1;
+
+(polyUpper - ZZZPhigher) / ZZZPhigher -> ((polyHorner - Phigher) / Phigher) + ((ZhCube - ZZZ) / ZZZ) * (polyHorner / Phigher) + 
+					  + ((polyUpper - (polyHorner * ZhCube)) / (polyHorner * ZhCube)) * (polyHorner / Phigher) +
+					  + ((ZhCube - ZZZ) / ZZZ) * ((polyUpper - (polyHorner * ZhCube)) / (polyHorner * ZhCube)) * 
+					    (polyHorner / Phigher);
+
+
+((ZhSquareHalfhl - (zh * zl)) - HZZ) / HZZ -> - ((zh - Z) / Z) * ((zh - Z) / Z);
+
+(ZhSquareHalfhl - HZZ) / HZZ -> (ZhSquarehl - ZZ) / ZZ;
+
+((T2hl - (zh * zl)) - ZpHZZ) / ZpHZZ -> ((HZ * (((ZhSquareHalfhl - (zh * zl)) - HZZ) / HZZ)) + ((T2hl - T2) / T2) 
+                                        + (HZ * ((T2hl - T2) / T2)) 
+					+ (HZ * ((ZhSquareHalfhl - HZZ) / HZZ) * ((T2hl - T2) / T2))) / (1 + HZ);
+
+(PE - P) / P -> (((1 + HZ) * (((T2hl - (zh * zl)) - ZpHZZ) / ZpHZZ)) +
+		((1 + ((zh - Z) / Z)) * (Z * ((zh - Z) / Z)) * ((Flzhzl - (zh * zl)) / (zh * zl))) 
+	        + (ZZ * Phigher * ((polyUpper - ZZZPhigher) / ZZZPhigher))) / (1 + HZ + ZZ * Phigher);
+
+(Phl - P) / P -> ((PE - P) / P) + ((((PE - P) / P) + 1) * ((Phl - PE) / PE));
+
+(Loghm - Log) / Log -> ((Loghm - P) / P) + ((P - Log) / Log) + ((Loghm - P) / P) * ((P - Log) / Log);
+
+(((logh + logm) - Log) / Log) -> (((logh + logm) - Loghm) / Loghm) + ((Loghm - Log) / Log) + (((logh + logm) - Loghm) / Loghm) * ((Loghm - Log) / Log);