LORENE
poisson_tau.C
1 /*
2  * Copyright (c) 2005 Philippe Grandclement
3 
4  * This file is part of LORENE.
5  *
6  * LORENE is free software; you can redistribute it and/or modify
7  * it under the terms of the GNU General Public License as published by
8  * the Free Software Foundation; either version 2 of the License, or
9  * (at your option) any later version.
10  *
11  * LORENE is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14  * GNU General Public License for more details.
15  *
16  * You should have received a copy of the GNU General Public License
17  * along with LORENE; if not, write to the Free Software
18  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19  *
20  */
21 
22 
23 
24 
25 /*
26  * $Id: poisson_tau.C,v 1.12 2018/11/16 14:34:36 j_novak Exp $
27  * $Log: poisson_tau.C,v $
28  * Revision 1.12 2018/11/16 14:34:36 j_novak
29  * Changed minor points to avoid some compilation warnings.
30  *
31  * Revision 1.11 2016/12/05 16:18:10 j_novak
32  * Suppression of some global variables (file names, loch, ...) to prevent redefinitions
33  *
34  * Revision 1.10 2014/10/13 08:53:30 j_novak
35  * Lorene classes and functions now belong to the namespace Lorene.
36  *
37  * Revision 1.9 2014/10/06 15:16:09 j_novak
38  * Modified #include directives to use c++ syntax.
39  *
40  * Revision 1.8 2013/06/05 15:10:43 j_novak
41  * Suppression of FINJAC sampling in r. This Jacobi(0,2) base is now
42  * available by setting colloc_r to BASE_JAC02 in the Mg3d constructor.
43  *
44  * Revision 1.7 2008/08/27 08:51:15 jl_cornou
45  * Added Jacobi(0,2) polynomials
46  *
47  * Revision 1.6 2007/12/14 10:19:34 jl_cornou
48  * *** empty log message ***
49  *
50  * Revision 1.4 2005/11/24 14:07:54 j_novak
51  * Use of Matrice::annule_hard()
52  *
53  * Revision 1.3 2005/08/26 14:02:41 p_grandclement
54  * Modification of the elliptic solver that matches with an oscillatory exterior solution
55  * small correction in Poisson tau also...
56  *
57  * Revision 1.2 2005/08/25 12:16:01 p_grandclement
58  * *** empty log message ***
59  *
60  *
61  * $Header: /cvsroot/Lorene/C++/Source/Non_class_members/PDE/poisson_tau.C,v 1.12 2018/11/16 14:34:36 j_novak Exp $
62  *
63  */
64 
65 // Header C :
66 #include <cstdlib>
67 #include <cmath>
68 
69 // Headers Lorene :
70 #include "matrice.h"
71 #include "map.h"
72 #include "proto.h"
73 #include "type_parite.h"
74 
75 
76 
77  //----------------------------------------------
78  // Version Mtbl_cf
79  //----------------------------------------------
80 
81 /*
82  *
83  * Solution de l'equation de poisson with a multi-domain Tau method
84  *
85  * Entree : mapping : le mapping affine
86  * source : les coefficients de la source qui a ete multipliee par
87  * r^4 r^3 ou r^2 dans la ZEC.
88  * La base de decomposition doit etre Ylm
89  * dzpuis : exposant de r dans le factor multiplicatif dans la ZEC
90  * Sortie : renvoie les coefficients de la solution dans la meme base de
91  * decomposition (a savoir Ylm)
92  *
93  */
94 
95 
96 namespace Lorene {
97 Mtbl_cf sol_poisson_tau(const Map_af& mapping, const Mtbl_cf& source, int dzpuis)
98 {
99 
100  // Verifications d'usage sur les zones
101  int nz = source.get_mg()->get_nzone() ;
102  assert (nz>1) ;
103  assert ((source.get_mg()->get_type_r(0) == RARE) || (source.get_mg()->get_type_r(0) == FIN)) ;
104  assert (source.get_mg()->get_type_r(nz-1) == UNSURR) ;
105  for (int l=1 ; l<nz-1 ; l++)
106  assert(source.get_mg()->get_type_r(l) == FIN) ;
107 
108  assert ((dzpuis==4) || (dzpuis==2) || (dzpuis==3)) ;
109 
110  // Bases spectrales
111  const Base_val& base = source.base ;
112 
113  // Resultat
114  Mtbl_cf resultat(source.get_mg(), base) ;
115  resultat.annule_hard() ;
116 
117  // donnees sur la zone
118  int nr, nt, np ;
119  int base_r ;
120  double alpha, beta, echelle ;
121  int l_quant, m_quant;
122 
123  // Determination of the size of the systeme :
124  int size = 0 ;
125  int max_nr = 0 ;
126  for (int l=0 ; l<nz ; l++) {
127  nr = mapping.get_mg()->get_nr(l) ;
128  size += nr ;
129  if (nr > max_nr)
130  max_nr = nr ;
131  }
132 
133  Matrice systeme (size, size) ;
134  systeme.set_etat_qcq() ;
135  Tbl sec_membre (size) ;
136 
137  np = mapping.get_mg()->get_np(0) ;
138  nt = mapping.get_mg()->get_nt(0) ;
139  Matrice* work ;
140 
141  // On bosse pour chaque l, m :
142  for (int k=0 ; k<np+1 ; k++)
143  for (int j=0 ; j<nt ; j++)
144  if (nullite_plm(j, nt, k, np, base) == 1) {
145 
146 // for (int lig=0 ; lig<size ; lig++)
147 // for (int col=0 ; col< size ; col++)
148 // systeme.set(lig,col) = 0 ;
149  systeme.annule_hard() ;
150  sec_membre.annule_hard() ;
151 
152  int column_courant = 0 ;
153  int ligne_courant = 0 ;
154 
155  //--------------------------
156  // NUCLEUS
157  //--------------------------
158 
159  nr = mapping.get_mg()->get_nr(0) ;
160  alpha = mapping.get_alpha()[0] ;
161  base.give_quant_numbers (0, k, j, m_quant, l_quant, base_r) ;
162  work = new Matrice (laplacien_mat(nr, l_quant, 0., 0, base_r)) ;
163 
164  int nbr_cl = 0 ;
165  // RARE case
166  if (source.get_mg()->get_type_r(0) == RARE) {
167  // regularity conditions :
168  if (l_quant > 1) {
169  nbr_cl = 1 ;
170  if (l_quant%2==0) {
171  //Even case
172  for (int col=0 ; col<nr ; col++)
173  if (col%2==0)
174  systeme.set(ligne_courant, col+column_courant) = 1 ;
175  else
176  systeme.set(ligne_courant, col+column_courant) = -1 ;
177  }
178  else {
179  //Odd case
180  for (int col=0 ; col<nr ; col++)
181  if (col%2==0)
182  systeme.set(ligne_courant, col+column_courant) = 2*col+1 ;
183  else
184  systeme.set(ligne_courant, col+column_courant) = -(2*col+1) ;
185  }
186  }
187  }
188 
189  // JACO02 case
190  else {
191  assert( base_r == R_JACO02) ;
192  // regularity conditions :
193  if (l_quant == 0) {
194  nbr_cl = 1 ;
195  for (int col=0 ; col<nr ; col++) {
196  systeme.set(ligne_courant, col+column_courant) = col*(col+1)*(col+2)*(col+3)/double(12)*(2*(col%2)-1);
197  }
198  }
199  else if (l_quant == 1) {
200  nbr_cl = 1 ;
201  for (int col=0 ; col<nr ; col++) {
202  systeme.set(ligne_courant, col+column_courant) = (col+1)*(col+2)/double(2)*(1-2*(col%2)) ;
203  }
204  }
205  else {
206  nbr_cl = 2 ;
207  for (int col=0 ; col<nr ; col++) {
208  systeme.set(ligne_courant, col+column_courant) = (col+1)*(col+2)/double(2)*(1-2*(col%2)) ;
209  systeme.set(ligne_courant+1, col+column_courant) = col*(col+1)*(col+2)*(col+3)/double(12)*(2*(col%2)-1) ;
210  }
211  }
212  }
213  ligne_courant += nbr_cl ;
214 
215  // L'operateur :
216  for (int lig=0 ; lig<nr-1-nbr_cl ; lig++) {
217  for (int col=0 ; col<nr ; col++)
218  systeme.set(lig+ligne_courant,col+column_courant) = (*work)(lig,col) ;
219  sec_membre.set(lig+ligne_courant) = alpha*alpha*source(0, k, j, lig) ;
220  }
221 
222  delete work ;
223  ligne_courant += nr-1-nbr_cl ;
224 
225  // Le raccord :
226  for (int col=0 ; col<nr ; col++) {
227  if (source.get_mg()->get_type_r(0) == RARE) {
228  // La fonction
229  systeme.set(ligne_courant, col+column_courant) = 1 ;
230  // Sa d�riv�e :
231  if (l_quant%2==0) {
232  systeme.set(ligne_courant+1, col+column_courant) = 4*col*col/alpha ;
233  }
234  else {
235  systeme.set(ligne_courant+1, col+column_courant) = (2*col+1)*(2*col+1)/alpha ;
236  }
237  }
238  else {
239  // La fonction
240  systeme.set(ligne_courant, col+column_courant) = 1 ;
241  // Sa dérivée :
242  systeme.set(ligne_courant+1, col+column_courant) = col*(col+3)/double(2)/alpha ;
243  }
244  }
245 
246  column_courant += nr ;
247 
248 
249 
250 
251  //--------------------------
252  // SHELLS
253  //--------------------------
254  for (int l=1 ; l<nz-1 ; l++) {
255 
256  nr = mapping.get_mg()->get_nr(l) ;
257  alpha = mapping.get_alpha()[l] ;
258  beta = mapping.get_beta()[l] ;
259  echelle = beta/alpha ;
260 
261  base.give_quant_numbers (l, k, j, m_quant, l_quant, base_r) ;
262  work = new Matrice (laplacien_mat(nr, l_quant, echelle, 0, base_r)) ;
263 
264  // matching with previous domain :
265  for (int col=0 ; col<nr ; col++) {
266  // La fonction
267  if (col%2==0)
268  systeme.set(ligne_courant, col+column_courant) = -1 ;
269  else
270  systeme.set(ligne_courant, col+column_courant) = 1 ;
271  // Sa d�riv�e :
272  if (col%2==0)
273  systeme.set(ligne_courant+1, col+column_courant) = col*col/alpha ;
274  else
275  systeme.set(ligne_courant+1, col+column_courant) = -col*col/alpha ;
276  }
277  ligne_courant += 2 ;
278 
279  // L'operateur :
280 
281  // source must be multiplied by (x+echelle)^2
282  Tbl source_aux(nr) ;
283  source_aux.set_etat_qcq() ;
284  for (int i=0 ; i<nr ; i++)
285  source_aux.set(i) = source(l,k,j,i)*alpha*alpha ;
286  Tbl xso(source_aux) ;
287  Tbl xxso(source_aux) ;
288  multx_1d(nr, &xso.t, R_CHEB) ;
289  multx_1d(nr, &xxso.t, R_CHEB) ;
290  multx_1d(nr, &xxso.t, R_CHEB) ;
291  source_aux = beta*beta/alpha/alpha*source_aux+2*beta/alpha*xso+xxso ;
292 
293  for (int lig=0 ; lig<nr-2 ; lig++) {
294  for (int col=0 ; col<nr ; col++)
295  systeme.set(lig+ligne_courant,col+column_courant) = (*work)(lig,col) ;
296  sec_membre.set(lig+ligne_courant) = source_aux(lig) ;
297  }
298 
299  delete work ;
300  ligne_courant += nr-2 ;
301  // Matching with the next domain :
302  for (int col=0 ; col<nr ; col++) {
303  // La fonction
304  systeme.set(ligne_courant, col+column_courant) = 1 ;
305  // Sa d�riv�e :
306  systeme.set(ligne_courant+1, col+column_courant) = col*col/alpha ;
307  }
308 
309  column_courant += nr ;
310  }
311 
312 
313  //--------------------------
314  // ZEC
315  //--------------------------
316  nr = mapping.get_mg()->get_nr(nz-1) ;
317  alpha = mapping.get_alpha()[nz-1] ;
318  beta = mapping.get_beta()[nz-1] ;
319 
320  base.give_quant_numbers (nz-1, k, j, m_quant, l_quant, base_r) ;
321  work = new Matrice(laplacien_mat(nr, l_quant, 0., dzpuis, base_r)) ;
322 
323  // Matching with the previous domain :
324  for (int col=0 ; col<nr ; col++) {
325  // La fonction
326  if (col%2==0)
327  systeme.set(ligne_courant, col+column_courant) = -1 ;
328  else
329  systeme.set(ligne_courant, col+column_courant) = 1 ;
330  // Sa d�riv�e :
331  if (col%2==0)
332  systeme.set(ligne_courant+1, col+column_courant) = -4*alpha*col*col ;
333  else
334  systeme.set(ligne_courant+1, col+column_courant) = 4*alpha*col*col ;
335  }
336  ligne_courant += 2 ;
337 
338  // Regularity and BC at infinity ?
339  nbr_cl =0 ;
340  switch (dzpuis) {
341  case 4 :
342  if (l_quant==0) {
343  nbr_cl = 1 ;
344  // Only BC at infinity :
345  for (int col=0 ; col<nr ; col++)
346  systeme.set(ligne_courant, col+column_courant) = 1 ;
347  }
348  else {
349  nbr_cl = 2 ;
350  // BC at infinity :
351  for (int col=0 ; col<nr ; col++)
352  systeme.set(ligne_courant, col+column_courant) = 1 ;
353  // Regularity :
354  for (int col=0 ; col<nr ; col++)
355  systeme.set(ligne_courant+1, col+column_courant) = -4*alpha*col*col ;
356  }
357  break ;
358 
359  case 3 :
360  nbr_cl = 1 ;
361  // Only BC at infinity :
362  for (int col=0 ; col<nr ; col++)
363  systeme.set(ligne_courant, col+column_courant) = 1 ;
364  break ;
365 
366  case 2 :
367  if (l_quant==0) {
368  nbr_cl = 1 ;
369  // Only BC at infinity :
370  for (int col=0 ; col<nr ; col++)
371  systeme.set(ligne_courant, col+column_courant) = 1 ;
372  }
373  break ;
374  default :
375  cout << "Unknown dzpuis in sol_poisson_tau ..." << endl ;
376  abort() ;
377  }
378 
379  ligne_courant += nbr_cl ;
380 
381  // Multiplication of the source :
382  double indic = 1 ;
383  switch (dzpuis) {
384  case 4 :
385  indic = alpha*alpha ;
386  break ;
387  case 3 :
388  indic = alpha ;
389  break ;
390  default :
391  break ;
392  }
393 
394  // L'operateur :
395  for (int lig=0 ; lig<nr-1-nbr_cl ; lig++) {
396  for (int col=0 ; col<nr ; col++)
397  systeme.set(lig+ligne_courant,col+column_courant) = (*work)(lig,col) ;
398  sec_membre.set(lig+ligne_courant) = indic*source(nz-1, k, j, lig) ;
399  }
400  delete work ;
401 
402  // Solving the system:
403  systeme.set_band (max_nr, max_nr) ;
404  systeme.set_lu() ;
405  Tbl soluce (systeme.inverse(sec_membre)) ;
406 
407  // On range :
408  int conte = 0 ;
409  for (int l=0 ; l<nz ; l++) {
410  nr = mapping.get_mg()->get_nr(l) ;
411  for (int i=0 ; i<nr ; i++) {
412  resultat.set(l,k,j,i) = soluce(conte) ;
413  conte ++ ;
414  }
415  }
416 
417  }
418 
419  return resultat ;
420 }
421 }
Lorene prototypes.
Definition: app_hor.h:67
#define R_JACO02
base de Jacobi(0,2) ordinaire (finjac)
Definition: type_parite.h:188
const Mg3d * get_mg() const
Returns the Mg3d on which the Mtbl_cf is defined.
Definition: mtbl_cf.h:463
int get_nzone() const
Returns the number of domains.
Definition: grilles.h:465
#define R_CHEB
base de Chebychev ordinaire (fin)
Definition: type_parite.h:166