123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246 |
- /*
- Copyright (c) 2010, Intel Corporation
- All rights reserved.
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions
- are met:
- - Redistributions of source code must retain the above
- copyright notice, this list of conditions and the following
- disclaimer.
- - Redistributions in binary form must reproduce the above
- copyright notice, this list of conditions and the following
- disclaimer in the documentation and/or other materials
- provided with the distribution.
- - Neither the name of Intel Corporation nor the names of its
- contributors may be used to endorse or promote products derived
- from this software without specific prior written permission.
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
- #include "applu_share.h"
- #include "applu_macros.h"
- void buts(int k, double *tv) {
- //c compute the regular-sparse, block upper triangular solution:
- //c local variables
- int i, j, m;
- int iex;
- double tmp, tmp1;
- double tmat[5*5];
- //c receive data from south and east
- iex = 1;
- exchange_1(rsd, k, iex);
- for (j=jend; j>=jst; j--) {
- for (i=iend; i>=ist; i--) {
- for (m=1; m<=5; m++) {
- tv( m, i, j ) =
- omega * ( c( m, 1, i, j ) * rsd( 1, i, j, k+1 )
- + c( m, 2, i, j ) * rsd( 2, i, j, k+1 )
- + c( m, 3, i, j ) * rsd( 3, i, j, k+1 )
- + c( m, 4, i, j ) * rsd( 4, i, j, k+1 )
- + c( m, 5, i, j ) * rsd( 5, i, j, k+1 ) );
- }
- }
- }
- for (j=jend; j>=jst; j--) {
- for (i=iend; i>=ist; i--) {
- for (m=1; m<=5; m++) {
- tv( m, i, j ) = tv( m, i, j )
- + omega * ( b( m, 1, i, j ) * rsd( 1, i, j+1, k )
- + a( m, 1, i, j ) * rsd( 1, i+1, j, k )
- + b( m, 2, i, j ) * rsd( 2, i, j+1, k )
- + a( m, 2, i, j ) * rsd( 2, i+1, j, k )
- + b( m, 3, i, j ) * rsd( 3, i, j+1, k )
- + a( m, 3, i, j ) * rsd( 3, i+1, j, k )
- + b( m, 4, i, j ) * rsd( 4, i, j+1, k )
- + a( m, 4, i, j ) * rsd( 4, i+1, j, k )
- + b( m, 5, i, j ) * rsd( 5, i, j+1, k )
- + a( m, 5, i, j ) * rsd( 5, i+1, j, k ) );
- }
- //c---------------------------------------------------------------------
- //c diagonal block inversion
- //c---------------------------------------------------------------------
- for (m=1; m<=5; m++) {
- tmat( m, 1 ) = d( m, 1, i, j );
- tmat( m, 2 ) = d( m, 2, i, j );
- tmat( m, 3 ) = d( m, 3, i, j );
- tmat( m, 4 ) = d( m, 4, i, j );
- tmat( m, 5 ) = d( m, 5, i, j );
- }
- tmp1 = 1.0 / tmat( 1, 1 );
- tmp = tmp1 * tmat( 2, 1 );
- tmat( 2, 2 ) = tmat( 2, 2 )
- - tmp * tmat( 1, 2 );
- tmat( 2, 3 ) = tmat( 2, 3 )
- - tmp * tmat( 1, 3 );
- tmat( 2, 4 ) = tmat( 2, 4 )
- - tmp * tmat( 1, 4 );
- tmat( 2, 5 ) = tmat( 2, 5 )
- - tmp * tmat( 1, 5 );
- tv( 2, i, j ) = tv( 2, i, j )
- - tv( 1, i, j ) * tmp;
- tmp = tmp1 * tmat( 3, 1 );
- tmat( 3, 2 ) = tmat( 3, 2 )
- - tmp * tmat( 1, 2 );
- tmat( 3, 3 ) = tmat( 3, 3 )
- - tmp * tmat( 1, 3 );
- tmat( 3, 4 ) = tmat( 3, 4 )
- - tmp * tmat( 1, 4 );
- tmat( 3, 5 ) = tmat( 3, 5 )
- - tmp * tmat( 1, 5 );
- tv( 3, i, j ) = tv( 3, i, j )
- - tv( 1, i, j ) * tmp;
- tmp = tmp1 * tmat( 4, 1 );
- tmat( 4, 2 ) = tmat( 4, 2 )
- - tmp * tmat( 1, 2 );
- tmat( 4, 3 ) = tmat( 4, 3 )
- - tmp * tmat( 1, 3 );
- tmat( 4, 4 ) = tmat( 4, 4 )
- - tmp * tmat( 1, 4 );
- tmat( 4, 5 ) = tmat( 4, 5 )
- - tmp * tmat( 1, 5 );
- tv( 4, i, j ) = tv( 4, i, j )
- - tv( 1, i, j ) * tmp;
- tmp = tmp1 * tmat( 5, 1 );
- tmat( 5, 2 ) = tmat( 5, 2 )
- - tmp * tmat( 1, 2 );
- tmat( 5, 3 ) = tmat( 5, 3 )
- - tmp * tmat( 1, 3 );
- tmat( 5, 4 ) = tmat( 5, 4 )
- - tmp * tmat( 1, 4 );
- tmat( 5, 5 ) = tmat( 5, 5 )
- - tmp * tmat( 1, 5 );
- tv( 5, i, j ) = tv( 5, i, j )
- - tv( 1, i, j ) * tmp;
- tmp1 = 1.0 / tmat( 2, 2 );
- tmp = tmp1 * tmat( 3, 2 );
- tmat( 3, 3 ) = tmat( 3, 3 )
- - tmp * tmat( 2, 3 );
- tmat( 3, 4 ) = tmat( 3, 4 )
- - tmp * tmat( 2, 4 );
- tmat( 3, 5 ) = tmat( 3, 5 )
- - tmp * tmat( 2, 5 );
- tv( 3, i, j ) = tv( 3, i, j )
- - tv( 2, i, j ) * tmp;
- tmp = tmp1 * tmat( 4, 2 );
- tmat( 4, 3 ) = tmat( 4, 3 )
- - tmp * tmat( 2, 3 );
- tmat( 4, 4 ) = tmat( 4, 4 )
- - tmp * tmat( 2, 4 );
- tmat( 4, 5 ) = tmat( 4, 5 )
- - tmp * tmat( 2, 5 );
- tv( 4, i, j ) = tv( 4, i, j )
- - tv( 2, i, j ) * tmp;
- tmp = tmp1 * tmat( 5, 2 );
- tmat( 5, 3 ) = tmat( 5, 3 )
- - tmp * tmat( 2, 3 );
- tmat( 5, 4 ) = tmat( 5, 4 )
- - tmp * tmat( 2, 4 );
- tmat( 5, 5 ) = tmat( 5, 5 )
- - tmp * tmat( 2, 5 );
- tv( 5, i, j ) = tv( 5, i, j )
- - tv( 2, i, j ) * tmp;
- tmp1 = 1.0 / tmat( 3, 3 );
- tmp = tmp1 * tmat( 4, 3 );
- tmat( 4, 4 ) = tmat( 4, 4 )
- - tmp * tmat( 3, 4 );
- tmat( 4, 5 ) = tmat( 4, 5 )
- - tmp * tmat( 3, 5 );
- tv( 4, i, j ) = tv( 4, i, j )
- - tv( 3, i, j ) * tmp;
- tmp = tmp1 * tmat( 5, 3 );
- tmat( 5, 4 ) = tmat( 5, 4 )
- - tmp * tmat( 3, 4 );
- tmat( 5, 5 ) = tmat( 5, 5 )
- - tmp * tmat( 3, 5 );
- tv( 5, i, j ) = tv( 5, i, j )
- - tv( 3, i, j ) * tmp;
- tmp1 = 1.0 / tmat( 4, 4 );
- tmp = tmp1 * tmat( 5, 4 );
- tmat( 5, 5 ) = tmat( 5, 5 )
- - tmp * tmat( 4, 5 );
- tv( 5, i, j ) = tv( 5, i, j )
- - tv( 4, i, j ) * tmp;
- //c---------------------------------------------------------------------
- //c back substitution
- //c---------------------------------------------------------------------
- tv( 5, i, j ) = tv( 5, i, j )
- / tmat( 5, 5 );
- tv( 4, i, j ) = tv( 4, i, j )
- - tmat( 4, 5 ) * tv( 5, i, j );
- tv( 4, i, j ) = tv( 4, i, j )
- / tmat( 4, 4 );
- tv( 3, i, j ) = tv( 3, i, j )
- - tmat( 3, 4 ) * tv( 4, i, j )
- - tmat( 3, 5 ) * tv( 5, i, j );
- tv( 3, i, j ) = tv( 3, i, j )
- / tmat( 3, 3 );
- tv( 2, i, j ) = tv( 2, i, j )
- - tmat( 2, 3 ) * tv( 3, i, j )
- - tmat( 2, 4 ) * tv( 4, i, j )
- - tmat( 2, 5 ) * tv( 5, i, j );
- tv( 2, i, j ) = tv( 2, i, j )
- / tmat( 2, 2 );
- tv( 1, i, j ) = tv( 1, i, j )
- - tmat( 1, 2 ) * tv( 2, i, j )
- - tmat( 1, 3 ) * tv( 3, i, j )
- - tmat( 1, 4 ) * tv( 4, i, j )
- - tmat( 1, 5 ) * tv( 5, i, j );
- tv( 1, i, j ) = tv( 1, i, j )
- / tmat( 1, 1 );
- rsd( 1, i, j, k ) = rsd( 1, i, j, k ) - tv( 1, i, j );
- rsd( 2, i, j, k ) = rsd( 2, i, j, k ) - tv( 2, i, j );
- rsd( 3, i, j, k ) = rsd( 3, i, j, k ) - tv( 3, i, j );
- rsd( 4, i, j, k ) = rsd( 4, i, j, k ) - tv( 4, i, j );
- rsd( 5, i, j, k ) = rsd( 5, i, j, k ) - tv( 5, i, j );
- }
- }
- //c---------------------------------------------------------------------
- //c send data to north and west
- //c---------------------------------------------------------------------
- iex = 3;
- exchange_1(rsd, k, iex);
-
- return;
- }
|