[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 | |
---|
| 9 | void 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 | } |
---|