NFFT  3.3.2
legendre.c
00001 /*
00002  * Copyright (c) 2002, 2016 Jens Keiner, Stefan Kunis, Daniel Potts
00003  *
00004  * This program is free software; you can redistribute it and/or modify it under
00005  * the terms of the GNU General Public License as published by the Free Software
00006  * Foundation; either version 2 of the License, or (at your option) any later
00007  * version.
00008  *
00009  * This program is distributed in the hope that it will be useful, but WITHOUT
00010  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
00011  * FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
00012  * details.
00013  *
00014  * You should have received a copy of the GNU General Public License along with
00015  * this program; if not, write to the Free Software Foundation, Inc., 51
00016  * Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
00017  */
00018 
00019 #include <math.h>
00020 #include <stdio.h>
00021 #include "infft.h"
00022 #include "legendre.h"
00023 #include "infft.h"
00024 
00025 /* One over sqrt(pi) */
00026 DK(KSQRTPII,0.56418958354775628694807945156077258584405062932900);
00027 
00028 static inline R alpha_al(const int k, const int n)
00029 {
00030   if (k > 0)
00031   {
00032     if (k < n)
00033       return IF(k%2,K(1.0),K(-1.0));
00034     else
00035       return SQRT(((R)(2*k+1))/((R)(k-n+1)))*SQRT((((R)(2*k+1))/((R)(k+n+1))));
00036   }
00037   else if (k == 0)
00038   {
00039     if (n == 0)
00040       return K(1.0);
00041     else
00042       return IF(n%2,K(0.0),K(-1.0));
00043   }
00044   return K(0.0);
00045 }
00046 
00047 static inline R beta_al(const int k, const int n)
00048 {
00049   if (0 <= k && k < n)
00050     return K(1.0);
00051   else
00052     return K(0.0);
00053 }
00054 
00055 static inline R gamma_al(const int k, const int n)
00056 {
00057   if (k == -1)
00058     return SQRT(KSQRTPII*nfft_lambda((R)(n),K(0.5)));
00059   else if (k <= n)
00060     return K(0.0);
00061   else
00062     return -SQRT(((R)(k-n))/((R)(k-n+1))*((R)(k+n))/((R)(k+n+1)));
00063 }
00064 
00065 void alpha_al_row(R *alpha, const int N, const int n)
00066 {
00067   int j;
00068   R *p = alpha;
00069   for (j = -1; j <= N; j++)
00070     *p++ = alpha_al(j,n);
00071 }
00072 
00073 void beta_al_row(R *beta, const int N, const int n)
00074 {
00075   int j;
00076   R *p = beta;
00077   for (j = -1; j <= N; j++)
00078     *p++ = beta_al(j,n);
00079 }
00080 
00081 void gamma_al_row(R *gamma, const int N, const int n)
00082 {
00083   int j;
00084   R *p = gamma;
00085   for (j = -1; j <= N; j++)
00086     *p++ = gamma_al(j,n);
00087 }
00088 
00089 inline void alpha_al_all(R *alpha, const int N)
00090 {
00091   int i,j;
00092   R *p = alpha;
00093   for (i = 0; i <= N; i++)
00094     for (j = -1; j <= N; j++)
00095       *p++ = alpha_al(j,i);
00096 }
00097 
00098 inline void beta_al_all(R *alpha, const int N)
00099 {
00100   int i,j;
00101   R *p = alpha;
00102   for (i = 0; i <= N; i++)
00103     for (j = -1; j <= N; j++)
00104       *p++ = beta_al(j,i);
00105 }
00106 
00107 inline void gamma_al_all(R *alpha, const int N)
00108 {
00109   int i,j;
00110   R *p = alpha;
00111   for (i = 0; i <= N; i++)
00112     for (j = -1; j <= N; j++)
00113       *p++ = gamma_al(j,i);
00114 }
00115 
00116 void eval_al(R *x, R *y, const int size, const int k, R *alpha,
00117   R *beta, R *gamma)
00118 {
00119   /* Evaluate the associated Legendre polynomial P_{k,nleg} (l,x) for the vector
00120    * of knots  x[0], ..., x[size-1] by the Clenshaw algorithm
00121    */
00122   int i,j;
00123   R a,b,x_val_act,a_old;
00124   R *x_act, *y_act;
00125   R *alpha_act, *beta_act, *gamma_act;
00126 
00127   /* Traverse all nodes. */
00128   x_act = x;
00129   y_act = y;
00130   for (i = 0; i < size; i++)
00131   {
00132     a = 1.0;
00133     b = 0.0;
00134     x_val_act = *x_act;
00135 
00136     if (k == 0)
00137     {
00138       *y_act = 1.0;
00139     }
00140     else
00141     {
00142       alpha_act = &(alpha[k]);
00143       beta_act = &(beta[k]);
00144       gamma_act = &(gamma[k]);
00145       for (j = k; j > 1; j--)
00146       {
00147         a_old = a;
00148         a = b + a_old*((*alpha_act)*x_val_act+(*beta_act));
00149          b = a_old*(*gamma_act);
00150         alpha_act--;
00151         beta_act--;
00152         gamma_act--;
00153       }
00154       *y_act = (a*((*alpha_act)*x_val_act+(*beta_act))+b);
00155     }
00156     x_act++;
00157     y_act++;
00158   }
00159 }
00160 
00161 int eval_al_thresh(R *x, R *y, const int size, const int k, R *alpha,
00162   R *beta, R *gamma, R threshold)
00163 {
00164   /* Evaluate the associated Legendre polynomial P_{k,nleg} (l,x) for the vector
00165    * of knots  x[0], ..., x[size-1] by the Clenshaw algorithm
00166    */
00167   int i,j;
00168   R a,b,x_val_act,a_old;
00169   R *x_act, *y_act;
00170   R *alpha_act, *beta_act, *gamma_act;
00171 
00172   /* Traverse all nodes. */
00173   x_act = x;
00174   y_act = y;
00175   for (i = 0; i < size; i++)
00176   {
00177     a = 1.0;
00178     b = 0.0;
00179     x_val_act = *x_act;
00180 
00181     if (k == 0)
00182     {
00183      *y_act = 1.0;
00184     }
00185     else
00186     {
00187       alpha_act = &(alpha[k]);
00188       beta_act = &(beta[k]);
00189       gamma_act = &(gamma[k]);
00190       for (j = k; j > 1; j--)
00191       {
00192         a_old = a;
00193         a = b + a_old*((*alpha_act)*x_val_act+(*beta_act));
00194          b = a_old*(*gamma_act);
00195         alpha_act--;
00196         beta_act--;
00197         gamma_act--;
00198       }
00199       *y_act = (a*((*alpha_act)*x_val_act+(*beta_act))+b);
00200       if (fabs(*y_act) > threshold)
00201       {
00202         return 1;
00203       }
00204     }
00205     x_act++;
00206     y_act++;
00207   }
00208   return 0;
00209 }