xref: /phasta/phSolver/compressible/i3ldu.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)

        subroutine i3LDU (Diag, r, code)
c
c----------------------------------------------------------------------
c
c This routine preforms a Cholesky factorization/solve of a set of
c symmetric matrices for 3-D computations, used for block diagonal
c preconditioning in the iterative driver.
c
c input:
c  Diag (numnp,nsymdf)  : block diagonal (symmetric storage)
c  r    (numnp,nflow)    : residual
c  code                 : operation code
c                           .eq. 'LDU_Fact', Cholesky Factor
c                           .eq. 'forward ', forward reduction
c                           .eq. 'backward', backward substitution
c                           .eq. 'product ', product Diag.r
c
c output:
c  Diag (numnp,nsymdf)  : Cholesky decomp. of block diagonal
c  r    (numnp,nflow)    : reduced residual
c
c
c Note: the formulation used here to reduce the diagonal block to
c       symmetric Cholesky triangle is taken from Golub's "Matrix
c       Computations" Book, pages 89 algorithm 5.2-1.  Followed by
c       standard solve.
c
c
c              Diag(1)   Diag(2)     Diag(4)     Diag(7)      Diag(11)
c   T             0      Diag(3)     Diag(5)     Diag(8)      Diag(12)
c  L  =  U  =     0         0        Diag(6)     Diag(9)      Diag(13)
c                 0         0           0        Diag(10)     Diag(14)
c                 0         0           0           0         Diag(15)
c
c  The diagonal terms 1, 3, 6, 10 and 15 are stored in inverted form.
c
c Farzin Shakib, Spring 1987.
c Zdenek Johan,  Fall   1989.  (Modified for option 'product')
c Zdenek Johan,  Winter 1991.  (Fortran 90)
c----------------------------------------------------------------------
c
        include "common.h"
c
        dimension Diag(nshg,nsymdf),        r(nshg,nflow)
c
        character*8 code
c
c.... perform Cholesky decomposition with the Diagonal terms inverted
c
        if (code .eq. 'LDU_Fact') then
c
          Diag(:, 1) = one   / sqrt (Diag(:, 1))
c
          Diag(:, 2) = Diag(:, 1) *  Diag(:, 2)
          Diag(:, 3) = Diag(:, 3) -  Diag(:, 2) * Diag(:, 2)
          Diag(:, 3) = one   / sqrt (Diag(:, 3))
c
          Diag(:, 4) = Diag(:, 1) *  Diag(:, 4)
          Diag(:, 5) = Diag(:, 3) * (Diag(:, 5)
     &                            -  Diag(:, 4) * Diag(:, 2))
          Diag(:, 6) = Diag(:, 6) -  Diag(:, 4) * Diag(:, 4)
     &                            -  Diag(:, 5) * Diag(:, 5)
          Diag(:, 6) = one   / sqrt (Diag(:, 6))
c
          Diag(:, 7) = Diag(:, 1) *  Diag(:, 7)
          Diag(:, 8) = Diag(:, 3) * (Diag(:, 8)
     &                            -  Diag(:, 7) * Diag(:, 2))
          Diag(:, 9) = Diag(:, 6) * (Diag(:, 9)
     &                            -  Diag(:, 7) * Diag(:, 4)
     &                            -  Diag(:, 8) * Diag(:, 5))
c
          Diag(:,10) = Diag(:,10) -  Diag(:, 7) * Diag(:, 7)
     &                            -  Diag(:, 8) * Diag(:, 8)
     &                            -  Diag(:, 9) * Diag(:, 9)
          Diag(:,10) = one   / sqrt (Diag(:,10))
c
          Diag(:,11) = Diag(:, 1) *  Diag(:,11)
          Diag(:,12) = Diag(:, 3) * (Diag(:,12)
     &                            -  Diag(:,11) * Diag(:, 2))
          Diag(:,13) = Diag(:, 6) * (Diag(:,13)
     &                            -  Diag(:,11) * Diag(:, 4)
     &                            -  Diag(:,12) * Diag(:, 5))
          Diag(:,14) = Diag(:,10) * (Diag(:,14)
     &                            -  Diag(:,11) * Diag(:, 7)
     &                            -  Diag(:,12) * Diag(:, 8)
     &                            -  Diag(:,13) * Diag(:, 9))
c
          Diag(:,15) = Diag(:,15) -  Diag(:,11) * Diag(:,11)
     &                            -  Diag(:,12) * Diag(:,12)
     &                            -  Diag(:,13) * Diag(:,13)
     &                            -  Diag(:,14) * Diag(:,14)
          Diag(:,15) = one   / sqrt (Diag(:,15))
c
c.... flop count
c
          flops = flops + 110*nshg
c
          return
        endif
c
c.... perform forward reduction
c
        if (code .eq. 'forward ') then
c
          r(:,1) = Diag(:, 1) *   r(:,1)
          r(:,2) = Diag(:, 3) * ( r(:,2)
     &                        -   r(:,1) * Diag(:, 2) )
          r(:,3) = Diag(:, 6) * ( r(:,3)
     &                        -   r(:,1) * Diag(:, 4)
     &                        -   r(:,2) * Diag(:, 5) )
          r(:,4) = Diag(:,10) * ( r(:,4)
     &                        -   r(:,1) * Diag(:, 7)
     &                        -   r(:,2) * Diag(:, 8)
     &                        -   r(:,3) * Diag(:, 9) )
          r(:,5) = Diag(:,15) * ( r(:,5)
     &                        -   r(:,1) * Diag(:,11)
     &                        -   r(:,2) * Diag(:,12)
     &                        -   r(:,3) * Diag(:,13)
     &                        -   r(:,4) * Diag(:,14) )
c
c.... flop count
c
          flops = flops + 25*nshg
c
          return
        endif
c
c.... perform backward substitution
c
        if (code .eq. 'backward') then
c
          r(:,5) = Diag(:,15) *   r(:,5)
          r(:,4) = Diag(:,10) * ( r(:,4)
     &                        -   r(:,5) * Diag(:,14) )
          r(:,3) = Diag(:, 6) * ( r(:,3)
     &                        -   r(:,5) * Diag(:,13)
     &                        -   r(:,4) * Diag(:, 9) )
          r(:,2) = Diag(:, 3) * ( r(:,2)
     &                        -   r(:,5) * Diag(:,12)
     &                        -   r(:,4) * Diag(:, 8)
     &                        -   r(:,3) * Diag(:, 5) )
          r(:,1) = Diag(:, 1) * ( r(:,1)
     &                        -   r(:,5) * Diag(:,11)
     &                        -   r(:,4) * Diag(:, 7)
     &                        -   r(:,3) * Diag(:, 4)
     &                        -   r(:,2) * Diag(:, 2) )
c
c.... flop count
c
          flops = flops + 25*nshg
c
          return
        endif
c
c.... perform product U.r
c
        if (code .eq. 'product ') then
c
          r(:,1) = r(:,1) / Diag(:, 1) + r(:,2) * Diag(:, 2) +
     &             r(:,3) * Diag(:, 4) + r(:,4) * Diag(:, 7) +
     &             r(:,5) * Diag(:,11)
          r(:,2) = r(:,2) / Diag(:, 3) + r(:,3) * Diag(:, 5) +
     &             r(:,4) * Diag(:, 8) + r(:,5) * Diag(:,12)
          r(:,3) = r(:,3) / Diag(:, 6) + r(:,4) * Diag(:, 9) +
     &             r(:,5) * Diag(:,13)
          r(:,4) = r(:,4) / Diag(:,10) + r(:,5) * Diag(:,14)
          r(:,5) = r(:,5) / Diag(:,15)
c
c.... flop count
c
          flops = flops + 40*nshg
c
          return
        endif
c
        call error ('i3LDU   ', code, 0)
c
c.... return
c
        return
        end