source: trunk/LMDZ.TITAN/libf/chimtitan/solve_b.c @ 1243

Last change on this file since 1243 was 1126, checked in by slebonnois, 11 years ago

SL: update of Titan photochemical module to include computation of chemistry up to 1300 km

File size: 3.8 KB
RevLine 
[1126]1/* matrix inversion */
2/* cf Numerical Recipes LU Method for equations numbers */
3/* GCCM */
4/* similaire a inv (GP) */
5/* la matrice a est inversee seulement sur le bloc [n0;n1][n0;n1] */
6
7#include "titan.h"
8
9void solve_b( double ***aa, double **f, int m, int n0, int n1 )
10{
11   int    i,ii,imax,j,k,l,ll;
12   double **a,aamax,dum,*indx,sum,*vv,tmp;
13   FILE   *out;
14
15   indx = dm1d( n0, n1 );
16   vv   = dm1d( n0, n1 );
17   a    = dm2d( n0, n1, n0, n1 );
18   imax = n0;
19
20   for( i = n0; i <= n1; i++ ) for( j = n0; j <= n1; j++ ) a[i][j]=aa[m][i][j];
21   
22   for( i = n0; i <= n1; i++ )
23   {
24      aamax = 0.0e0;
25      for( k = n0; k <= n1; k++ )
26         if( (tmp=fabs(a[i][k])) > aamax ) aamax = tmp;
27      if( aamax < 1.0e-20 )
28      {
29         out = fopen( "err.log", "a" );
30         fprintf( out, "Singular matrix. n0=%ld k=%ld aamax=%le\n",
31                        n0,k,aamax);
32         fclose( out );
33         exit(0);   
34/*         aamax = 1.e-30; */
35      }
36      vv[i] = 1.0e0 / aamax;   /* Save the scaling */
37/*
38      if( (aamax > 1.0e100)||(aamax < 1.0e-100) )
39      {
40         out = fopen( "err.log", "a" );
41         fprintf( out, "ATTENTION aamax = %le\n", aamax );
42         fclose( out );
43         exit( 0 );
44      }
45*/
46   }
47   for( k = n0; k <= n1; k++ )
48   {
49      for( i = n0; i < k; i++ )      /* This is equation 2.3.12 except for i = j */
50      {
51         sum = a[i][k];
52         for( l = n0; l < i; l++ )
53            sum -= ( a[i][l] * a[l][k] );
54         a[i][k] = sum;
55      }
56      aamax = 0.0e0;                 /* Initialize for the search for largest pivot element */
57      for( i = k; i <= n1; i++ )     /* This is i = j of equation 2.3.12 and */
58      {
59         sum = a[i][k];              /* i = J + 1,...,N of equation 2.3.13 */
60         for( l = n0; l < k; l++ )
61            sum -= ( a[i][l] * a[l][k] );
62         a[i][k] = sum;
63         dum        = vv[i] * fabs(sum); /* Figure of merit for the pivot */
64         if( dum >= aamax )          /* Is it better than the best so far ? */
65         {
66            imax  = i;
67            aamax = dum;
68         }
69      }
70      if( k != imax )                /* Do we need to interchange rows ? */
71      {
72         for( l = n0; l <= n1; l++ ) /* Yes, do so... */
73         {
74            dum        = a[imax][l];
75            a[imax][l] = a[k][l];
76            a[k][l]    = dum;
77         }
78         vv[imax] = vv[k];    /* Also interchange the scale factor */
79      }
80      indx[k] = imax;
81      if( fabs(a[k][k]) < 1.0e-20 )
82      {
83         out = fopen( "err.log", "a" );
84         fprintf( out, "Pivot too small. n0=%ld k=%ld fabs(a[k][k])=%le\n",
85                        n0,k,fabs(a[k][k]) );
86         fclose( out );
87         exit(0);   
88/*         a[k][k] = 1.e-20; */
89      }
90      if( k != n1 )                   /* If the pivot element is less than 1.0d-20 we */
91      {                               /* assume that the matrix is singular */
92          dum = a[k][k];              /* ( at least to the precision of the algorithm and the machine ) */
93         for( i = k+1; i <= n1; i++ ) /* Now, finally devide by the pivot element */
94            a[i][k] /= dum;
95      }
96   }                                  /* Go back to the next column in the reduction */
97
98   for( i = n0; i <= n1; i++ ) vv[i]=f[i][m];
99
100      ii = n0-1;
101      for( i = n0; i <= n1; i++ )
102      {
103         ll    = indx[i];
104         sum   = vv[ll];
105         vv[ll] = vv[i];
106         if( ii != (n0-1) )
107            for( k = ii; k < i; k++ )
108               sum -= ( a[i][k] * vv[k] );
109         else if( sum != 0.0e0 ) ii = i;
110         vv[i] = sum;
111      }
112      for( i = n1; i >= n0; i-- )
113      {
114         sum = vv[i];
115         if( i < n1 )
116            for( k = i+1; k <= n1; k++ )
117               sum -= ( a[i][k] * vv[k] );
118         vv[i] = sum / a[i][i];
119      }
120         
121   for( i = n0; i <= n1; i++ ) f[i][m]=vv[i];
122
123   fdm1d( indx, n0 );
124   fdm1d(   vv, n0 );
125   fdm2d(    a, n0, n1, n0 );
126}
Note: See TracBrowser for help on using the repository browser.