citcossinc.C

00001 /*
00002  *   Copyright (c) 1999-2001 Eric Gourgoulhon
00003  *
00004  *   This file is part of LORENE.
00005  *
00006  *   LORENE is free software; you can redistribute it and/or modify
00007  *   it under the terms of the GNU General Public License as published by
00008  *   the Free Software Foundation; either version 2 of the License, or
00009  *   (at your option) any later version.
00010  *
00011  *   LORENE is distributed in the hope that it will be useful,
00012  *   but WITHOUT ANY WARRANTY; without even the implied warranty of
00013  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00014  *   GNU General Public License for more details.
00015  *
00016  *   You should have received a copy of the GNU General Public License
00017  *   along with LORENE; if not, write to the Free Software
00018  *   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00019  *
00020  */
00021 
00022 
00023 char citcossinc_C[] = "$Header: /cvsroot/Lorene/C++/Source/Non_class_members/Coef/FFT991/citcossinc.C,v 1.1 2004/12/21 17:06:01 j_novak Exp $" ;
00024 
00025 
00026 /*
00027  * Transformation inverse cos(l*theta) ou sin(l*theta) (suivant la 
00028  *  parite de l'indice m en phi) sur le deuxieme indice (theta)
00029  *  d'un tableau 3-D representant une fonction symetrique par rapport
00030  *  au plan z=0.
00031  *  Utilise la routine FFT Fortran FFT991
00032  *
00033  * Entree:
00034  * -------
00035  *   int* deg   : tableau du nombre effectif de degres de liberte dans chacune 
00036  *        des 3 dimensions: le nombre de points de collocation
00037  *        en theta est  nt = deg[1] et doit etre de la forme
00038  *          nt = 2^p 3^q 5^r + 1 
00039  *   int* dimc  : tableau du nombre d'elements de cc dans chacune des trois 
00040  *            dimensions.
00041  *        On doit avoir  dimc[1] >= deg[1] = nt. 
00042  *
00043  *   double* cf :   tableau des coefficients c_l de la fonction definis
00044  *            comme suit (a r et phi fixes)
00045  *
00046  *            pour m pair:
00047  *          f(theta) = som_{l=0}^{nt-1} c_l cos( l theta ) . 
00048  *            pour m impair:
00049  *          f(theta) = som_{l=0}^{nt-2} c_l sin( l theta ) . 
00050  *
00051  *            L'espace memoire correspondant a ce
00052  *                        pointeur doit etre dimc[0]*dimc[1]*dimc[2] et doit 
00053  *            avoir ete alloue avant l'appel a la routine.   
00054  *           Le coefficient c_l (0 <= l <= nt-1) doit etre stoke dans
00055  *           le tableau cf comme suit
00056  *                c_l = cf[ dimc[1]*dimc[2] * j + k + dimc[2] * l ]
00057  *           ou j et k sont les indices correspondant a
00058  *           phi et r respectivement.
00059  *
00060  *   int* dimf  : tableau du nombre d'elements de ff dans chacune des trois 
00061  *            dimensions.
00062  *        On doit avoir  dimf[1] >= deg[1] = nt. 
00063  *
00064  * Sortie:
00065  * -------
00066  *   double* ff : tableau des valeurs de la fonction aux nt points de
00067  *                        de collocation
00068  *
00069  *            theta_l =  pi l/(nt-1)       0 <= l <= nt-1 
00070  *
00071  *            L'espace memoire correspondant a ce
00072  *                        pointeur doit etre dimf[0]*dimf[1]*dimf[2] et doit 
00073  *            avoir ete alloue avant l'appel a la routine.   
00074  *            Les valeurs de la fonction sont stokees
00075  *            dans le tableau ff comme suit
00076  *          f( theta_l ) = ff[ dimf[1]*dimf[2] * j + k + dimf[2] * l ]
00077  *           ou j et k sont les indices correspondant a
00078  *           phi et r respectivement.
00079  *
00080  * NB: Si le pointeur cf est egal a ff, la routine ne travaille que sur un 
00081  *     seul tableau, qui constitue une entree/sortie.
00082  *
00083  */
00084 
00085 /*
00086  * $Id: citcossinc.C,v 1.1 2004/12/21 17:06:01 j_novak Exp $
00087  * $Log: citcossinc.C,v $
00088  * Revision 1.1  2004/12/21 17:06:01  j_novak
00089  * Added all files for using fftw3.
00090  *
00091  * Revision 1.1  2004/11/23 15:13:50  m_forot
00092  * Added the bases for the cases without any equatorial symmetry
00093  * (T_COSSIN_C, T_COSSIN_S, T_LEG, R_CHEBPI_P, R_CHEBPI_I).
00094  *
00095  *
00096  * $Header: /cvsroot/Lorene/C++/Source/Non_class_members/Coef/FFT991/citcossinc.C,v 1.1 2004/12/21 17:06:01 j_novak Exp $
00097  *
00098  */
00099 // headers du C
00100 #include <assert.h>
00101 #include <stdlib.h>
00102 
00103 // Prototypes of F77 subroutines
00104 #include "headcpp.h"
00105 #include "proto_f77.h"
00106 
00107 // Prototypage des sous-routines utilisees:
00108 int*    facto_ini(int ) ;
00109 double* trigo_ini(int ) ;
00110 double* cheb_ini(const int) ;
00111 double* chebimp_ini(const int ) ;
00112 //*****************************************************************************
00113 
00114 void citcossinc(const int* deg, const int* dimc, double* cf, const int* dimf,
00115            double* ff)
00116 {
00117 
00118 int i, j, k ;
00119 
00120 // Dimensions des tableaux ff et cf  :
00121     int n1f = dimf[0] ;
00122     int n2f = dimf[1] ;
00123     int n3f = dimf[2] ;
00124     int n1c = dimc[0] ;
00125     int n2c = dimc[1] ;
00126     int n3c = dimc[2] ;
00127 
00128 // Nombres de degres de liberte en theta :    
00129     int nt = deg[1] ;
00130     
00131 // Tests de dimension:
00132     if (nt > n2f) {
00133     cout << "citcossinc: nt > n2f : nt = " << nt << " ,  n2f = " 
00134     << n2f << endl ;
00135     abort () ;
00136     exit(-1) ;
00137     }
00138     if (nt > n2c) {
00139     cout << "citcossinc: nt > n2c : nt = " << nt << " ,  n2c = " 
00140     << n2c << endl ;
00141     abort () ;
00142     exit(-1) ;
00143     }
00144     if (n1c > n1f) {
00145     cout << "citcossinc: n1c > n1f : n1c = " << n1c << " ,  n1f = " 
00146     << n1f << endl ;
00147     abort () ;
00148     exit(-1) ;
00149     }
00150     if (n3c > n3f) {
00151     cout << "citcossinc: n3c > n3f : n3c = " << n3c << " ,  n3f = " 
00152     << n3f << endl ;
00153     abort () ;
00154     exit(-1) ;
00155     }
00156 
00157 // Nombre de points pour la FFT:
00158     int nm1 = nt - 1;
00159     int nm1s2 = nm1 / 2;
00160 
00161 // Recherche des tables pour la FFT:
00162     int* facto = facto_ini(nm1) ;
00163     double* trigo = trigo_ini(nm1) ;
00164 
00165 // Recherche de la table des sin(psi) :
00166     double* sinp = cheb_ini(nt);    
00167     
00168 // Recherche de la table des sin( theta_l ) :
00169     double* sinth = chebimp_ini(nt);    
00170 
00171     // tableau de travail t1 et g
00172     //   (la dimension nm1+2 = nt+1 est exigee par la routine fft991)
00173     double* g = (double*)( malloc( (nm1+2)*sizeof(double) ) ) ; 
00174     double* t1 = (double*)( malloc( (nm1+2)*sizeof(double) ) ) ;
00175 
00176 // Parametres pour la routine FFT991
00177     int jump = 1 ;
00178     int inc = 1 ;
00179     int lot = 1 ;
00180     int isign = 1 ;
00181     
00182 // boucle sur phi et r (les boucles vont resp. de 0 a dimf[0]-1
00183 //           et 0 a dimf[2])
00184 
00185     int n2n3f = n2f * n3f ;
00186     int n2n3c = n2c * n3c ;
00187 
00188 //=======================================================================
00189 //              Cas m pair
00190 //=======================================================================
00191 
00192     j = 0 ;
00193     
00194     while (j<n1f-1) {   //le dernier coef en phi n'est pas considere
00195             // (car nul)
00196 
00197 //-----------------------------------------------------------------------
00198 //  partie cos(m phi) avec m pair : transformation cos( l theta) inverse
00199 //-----------------------------------------------------------------------
00200 
00201     for (k=0; k<n3c; k++) {
00202 
00203         int i0 = n2n3c * j + k ; // indice de depart 
00204         double* cf0 = cf + i0 ;    // tableau des donnees a transformer
00205 
00206         i0 = n2n3f * j + k ; // indice de depart 
00207         double* ff0 = ff + i0 ;    // tableau resultat
00208          
00209  
00210 // Coefficients impairs de G
00211 //--------------------------
00212  
00213         double c1 = cf0[n3c] ;
00214 
00215             double som = 0;
00216         ff0[n3f] = 0 ;
00217             for ( i = 3; i < nt; i += 2 ) {
00218             ff0[ n3f*i ] = cf0[ n3c*i ] - c1 ;
00219         som += ff0[ n3f*i ] ;
00220             }   
00221 
00222 // Valeur en theta=0 de la partie antisymetrique de F, F_ :
00223         double fmoins0 = nm1s2 * c1 + som ;
00224 
00225 // Coef. impairs de G
00226 // NB: le facteur 0.25 est du a la normalisation de fft991; si fft991
00227 //     donnait exactement les coef. des sinus, ce facteur serait -0.5.
00228             g[1] = 0 ;
00229             for ( i = 3; i < nt; i += 2 ) {
00230         g[i] = 0.25 * ( ff0[ n3f*i ] - ff0[ n3f*(i-2) ] ) ;
00231             }
00232             g[nt] = 0 ; 
00233 
00234 
00235 // Coefficients pairs de G
00236 //------------------------
00237 //  Ces coefficients sont egaux aux coefficients pairs du developpement de
00238 //   f.
00239 // NB: le facteur 0.5 est du a la normalisation de fft991; si fft991
00240 //     donnait exactement les coef. des cosinus, ce facteur serait 1.
00241 
00242         g[0] = cf0[0] ;
00243             for (i=2; i<nm1; i += 2 ) g[i] = 0.5 * cf0[ n3c*i ] ;   
00244             g[nm1] = cf0[ n3c*nm1 ] ;
00245 
00246 // Transformation de Fourier inverse de G 
00247 //---------------------------------------
00248 
00249 // FFT inverse
00250             F77_fft991( g, t1, trigo, facto, &inc, &jump, &nm1, &lot, &isign) ;
00251 
00252 // Valeurs de f deduites de celles de G
00253 //-------------------------------------
00254 
00255             for ( i = 1; i < nm1s2 ; i++ ) {
00256 // ... indice du pt symetrique de theta par rapport a pi/2:
00257         int isym = nm1 - i ; 
00258     
00259         double fp = 0.5 * ( g[i] + g[isym] ) ;
00260         double fm = 0.5 * ( g[i] - g[isym] ) / sinp[i] ;
00261         ff0[ n3f*i ] = fp + fm ;
00262         ff0[ n3f*isym ] = fp - fm ;
00263             }
00264     
00265 //... cas particuliers:
00266         ff0[0] = g[0] + fmoins0 ;
00267         ff0[ n3f*nm1 ] = g[0] - fmoins0 ;
00268         ff0[ n3f*nm1s2 ] = g[nm1s2] ;
00269 
00270 
00271     }   // fin de la boucle sur r 
00272 
00273 //-----------------------------------------------------------------------
00274 //  partie sin(m phi) avec m pair : transformation cos(l theta) inverse
00275 //-----------------------------------------------------------------------
00276 
00277     j++ ;
00278 
00279     if ( (j != 1) && (j != n1f-1 ) ) {  
00280 //  on effectue le calcul seulement dans les cas ou les coef en phi ne sont 
00281 //  pas nuls 
00282 
00283     for (k=0; k<n3c; k++) {
00284 
00285         int i0 = n2n3c * j + k ; // indice de depart 
00286         double* cf0 = cf + i0 ;    // tableau des donnees a transformer
00287 
00288         i0 = n2n3f * j + k ; // indice de depart 
00289         double* ff0 = ff + i0 ;    // tableau resultat
00290          
00291 // Coefficients impairs de G
00292 //--------------------------
00293  
00294         double c1 = cf0[n3c] ;
00295 
00296             double som = 0;
00297         ff0[n3f] = 0 ;
00298             for ( i = 3; i < nt; i += 2 ) {
00299             ff0[ n3f*i ] = cf0[ n3c*i ] - c1 ;
00300         som += ff0[ n3f*i ] ;
00301             }   
00302 
00303 // Valeur en theta=0 de la partie antisymetrique de F, F_ :
00304         double fmoins0 = nm1s2 * c1 + som ;
00305 
00306 // Coef. impairs de G
00307 // NB: le facteur 0.25 est du a la normalisation de fft991; si fft991
00308 //     donnait exactement les coef. des sinus, ce facteur serait -0.5.
00309             g[1] = 0 ;
00310             for ( i = 3; i < nt; i += 2 ) {
00311         g[i] = 0.25 * ( ff0[ n3f*i ] - ff0[ n3f*(i-2) ] ) ;
00312             }
00313             g[nt] = 0 ; 
00314 
00315 
00316 // Coefficients pairs de G
00317 //------------------------
00318 //  Ces coefficients sont egaux aux coefficients pairs du developpement de
00319 //   f.
00320 // NB: le facteur 0.5 est du a la normalisation de fft991; si fft991
00321 //     donnait exactement les coef. des cosinus, ce facteur serait 1.
00322 
00323         g[0] = cf0[0] ;
00324             for (i=2; i<nm1; i += 2 ) g[i] = 0.5 * cf0[ n3c*i ] ;   
00325             g[nm1] = cf0[ n3c*nm1 ] ;
00326 
00327 // Transformation de Fourier inverse de G 
00328 //---------------------------------------
00329 
00330 // FFT inverse
00331             F77_fft991( g, t1, trigo, facto, &inc, &jump, &nm1, &lot, &isign) ;
00332 
00333 // Valeurs de f deduites de celles de G
00334 //-------------------------------------
00335 
00336             for ( i = 1; i < nm1s2 ; i++ ) {
00337 // ... indice du pt symetrique de theta par rapport a pi/2:
00338         int isym = nm1 - i ; 
00339     
00340         double fp = 0.5 * ( g[i] + g[isym] ) ;
00341         double fm = 0.5 * ( g[i] - g[isym] ) / sinp[i] ;
00342         ff0[ n3f*i ] = fp + fm ;
00343         ff0[ n3f*isym ] = fp - fm ;
00344             }
00345     
00346 //... cas particuliers:
00347         ff0[0] = g[0] + fmoins0 ;
00348         ff0[ n3f*nm1 ] = g[0] - fmoins0 ;
00349         ff0[ n3f*nm1s2 ] = g[nm1s2] ;
00350 
00351 
00352     }   // fin de la boucle sur r 
00353 
00354     }    // fin du cas ou le calcul etait necessaire (i.e. ou les
00355          // coef en phi n'etaient pas nuls)
00356 
00357 // On passe au cas m pair suivant:
00358     j+=3 ;
00359 
00360    }    // fin de la boucle sur les cas m pair
00361 
00362 //##
00363     if (n1f<=3) {       // cas m=0 seulement (symetrie axiale)
00364     free (t1) ;
00365     free (g) ;
00366     return ;
00367     }
00368     
00369 //=======================================================================
00370 //              Cas m impair
00371 //=======================================================================
00372 
00373     j = 2 ;
00374     
00375     while (j<n1f-1) {   //le dernier coef en phi n'est pas considere
00376             // (car nul)
00377 
00378 //--------------------------------------------------------------------------
00379 //  partie cos(m phi) avec m impair : transformation sin(l theta) inv.
00380 //--------------------------------------------------------------------------
00381 
00382         for (k=0; k<n3c; k++) {
00383 
00384         int i0 = n2n3c * j + k ; // indice de depart 
00385         double* cf0 = cf + i0 ;    // tableau des donnees a transformer
00386 
00387         i0 = n2n3f * j + k ; // indice de depart 
00388         double* ff0 = ff + i0 ;    // tableau resultat
00389          
00390 // Coefficients impairs de G
00391 //--------------------------
00392  
00393         g[1] = 0 ;
00394         for (i=2; i<nm1; i += 2 ) g[i+1] = -0.5 * cf0[ n3c*i ] ;    
00395         g[nt] = 0 ; 
00396 
00397 
00398 // Coefficients pairs de G
00399 //------------------------
00400 
00401         g[0] = .5 * cf0[n3c] ;
00402             for ( i = 3; i < nt; i += 2 ) {
00403         g[i-1] = .25 * ( cf0[ n3c*i ] - cf0[ n3c*(i-2) ] ) ;
00404             }
00405         g[nm1] = - .5 * cf0[ n3c*(nt-2) ] ;
00406         
00407 // Transformation de Fourier inverse de G 
00408 //---------------------------------------
00409 
00410 // FFT inverse
00411             F77_fft991( g, t1, trigo, facto, &inc, &jump, &nm1, &lot, &isign) ;
00412 
00413 // Valeurs de f deduites de celles de G
00414 //-------------------------------------
00415 
00416             for ( i = 1; i < nm1s2 ; i++ ) {
00417 // ... indice du pt symetrique de theta par rapport a pi/2:
00418         int isym = nm1 - i ; 
00419     
00420         double fp = 0.5 * ( g[i] + g[isym] ) / sinp[i]  ;
00421         double fm = 0.5 * ( g[i] - g[isym] ) ;
00422         ff0[ n3f*i ] = fp + fm ;
00423         ff0[ n3f*isym ] = fp - fm ;
00424             }
00425     
00426 //... cas particuliers:
00427         ff0[0] = 0. ;
00428         ff0[ n3f*nm1 ] = -2*g[0] ;
00429         ff0[ n3f*nm1s2 ] = g[nm1s2] ;
00430 
00431 
00432     }   // fin de la boucle sur r 
00433 
00434 //--------------------------------------------------------------------------
00435 //  partie sin(m phi) avec m impair : transformation sin(l theta) inv.
00436 //--------------------------------------------------------------------------
00437 
00438     j++ ;
00439 
00440     if ( j != n1f-1  ) {  
00441 //  on effectue le calcul seulement dans les cas ou les coef en phi ne sont 
00442 //  pas nuls 
00443       
00444         for (k=0; k<n3c; k++) {
00445 
00446         int i0 = n2n3c * j + k ; // indice de depart 
00447         double* cf0 = cf + i0 ;    // tableau des donnees a transformer
00448 
00449         i0 = n2n3f * j + k ; // indice de depart 
00450         double* ff0 = ff + i0 ;    // tableau resultat
00451          
00452 // Coefficients impairs de G
00453 //--------------------------
00454  
00455         g[1] = 0 ;
00456         for (i=2; i<nm1; i += 2 ) g[i+1] = -0.5 * cf0[ n3c*i ] ;    
00457         g[nt] = 0 ; 
00458 
00459 
00460 // Coefficients pairs de G
00461 //------------------------
00462 
00463         g[0] = .5 * cf0[n3c] ;
00464             for ( i = 3; i < nt; i += 2 ) {
00465         g[i-1] = .25 * ( cf0[ n3c*i ] - cf0[ n3c*(i-2) ] ) ;
00466             }
00467         g[nm1] = - .5 * cf0[ n3c*(nt-2) ] ;
00468         
00469 // Transformation de Fourier inverse de G 
00470 //---------------------------------------
00471 
00472 // FFT inverse
00473             F77_fft991( g, t1, trigo, facto, &inc, &jump, &nm1, &lot, &isign) ;
00474 
00475 // Valeurs de f deduites de celles de G
00476 //-------------------------------------
00477 
00478             for ( i = 1; i < nm1s2 ; i++ ) {
00479 // ... indice du pt symetrique de psi par rapport a pi/2:
00480         int isym = nm1 - i ; 
00481     
00482         double fp = 0.5 * ( g[i] + g[isym] ) / sinp[i]  ;
00483         double fm = 0.5 * ( g[i] - g[isym] ) ;
00484         ff0[ n3f*i ] = fp + fm ;
00485         ff0[ n3f*isym ] = fp - fm ;
00486             }
00487     
00488 //... cas particuliers:
00489         ff0[0] = 0. ;
00490         ff0[ n3f*nm1 ] = -2*g[0] ;
00491         ff0[ n3f*nm1s2 ] = g[nm1s2] ;
00492 
00493 
00494     }   // fin de la boucle sur r 
00495 
00496     }    // fin du cas ou le calcul etait necessaire (i.e. ou les
00497          // coef en phi n'etaient pas nuls)
00498 
00499 // On passe au cas m impair suivant:
00500     j+=3 ;
00501 
00502    }    // fin de la boucle sur les cas m impair
00503 
00504     // Menage
00505     free (t1) ;
00506     free (g) ;
00507     
00508 }

Generated on Tue Feb 7 01:35:15 2012 for LORENE by  doxygen 1.4.6