![]() |
NFFT
3.3.2
|
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 }