c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine pinvr(c) c--------------------------------------------------------------------- c--------------------------------------------------------------------- c--------------------------------------------------------------------- c block-diagonal matrix-vector multiplication c--------------------------------------------------------------------- include 'header.h' integer i, j, k, c double precision r1, r2, r3, r4, r5, t1, t2 c--------------------------------------------------------------------- c treat only one cell c--------------------------------------------------------------------- do k = start(3,c), cell_size(3,c)-end(3,c)-1 do j = start(2,c), cell_size(2,c)-end(2,c)-1 do i = start(1,c), cell_size(1,c)-end(1,c)-1 r1 = rhs(i,j,k,1,c) r2 = rhs(i,j,k,2,c) r3 = rhs(i,j,k,3,c) r4 = rhs(i,j,k,4,c) r5 = rhs(i,j,k,5,c) t1 = bt * r1 t2 = 0.5d0 * ( r4 + r5 ) rhs(i,j,k,1,c) = bt * ( r4 - r5 ) rhs(i,j,k,2,c) = -r3 rhs(i,j,k,3,c) = r2 rhs(i,j,k,4,c) = -t1 + t2 rhs(i,j,k,5,c) = t1 + t2 end do end do end do return end