lu_fact_4 Subroutine

  1. lu_implementation.F90
  2. lu_implementation
  3. lu_fact_4

subroutine lu_fact_4(a, ipiv, info)

Uses

  • proc~~lu_fact_4~~UsesGraph proc~lu_fact_4 lu_fact_4 module~class_psblas class_psblas proc~lu_fact_4->module~class_psblas module~class_stopwatch class_stopwatch module~class_psblas->module~class_stopwatch module~tools_psblas tools_psblas module~class_psblas->module~tools_psblas module~class_stopwatch->module~tools_psblas psb_base_mod psb_base_mod module~class_stopwatch->psb_base_mod psb_prec_mod psb_prec_mod module~tools_psblas->psb_prec_mod module~tools_psblas->psb_base_mod psb_krylov_mod psb_krylov_mod module~tools_psblas->psb_krylov_mod

Arguments

Type IntentOptional AttributesName
real(kind=psb_dpk_), intent(inout) :: a(4,4)
integer, intent(out) :: ipiv(4)
integer, intent(out) :: info

Called by

proc~~lu_fact_4~~CalledByGraph proc~lu_fact_4 lu_fact_4 proc~lu_fact lu_fact proc~lu_fact->proc~lu_fact_4 interface~lu_fact lu_fact interface~lu_fact->proc~lu_fact interface~factorize factorize interface~factorize->interface~lu_fact proc~alloc_plane alloc_plane proc~alloc_plane->interface~factorize interface~alloc_plane alloc_plane interface~alloc_plane->proc~alloc_plane proc~alloc_surface alloc_surface proc~alloc_surface->interface~alloc_plane interface~alloc_surface alloc_surface interface~alloc_surface->proc~alloc_surface

Contents

Source Code

lu_fact_4

Source Code

    SUBROUTINE  lu_fact_4(a,ipiv,info)
        USE class_psblas, ONLY : psb_dpk_

        REAL(psb_dpk_), INTENT(INOUT) :: A(4,4)
        INTEGER, INTENT(OUT) :: ipiv(4)
        INTEGER, INTENT(OUT) :: info
        !
        REAL(psb_dpk_) :: tmp, swp(4)
        INTEGER :: j, k, jp
        REAL(psb_dpk_), PARAMETER :: tol = 1.d-20

        info = 0

        IF (.FALSE.) THEN
            DO j = 1, 4
                jp = j - 1 + MAXLOC(ABS(a(j:,j)),dim=1)
                ipiv(j) = jp
                IF (jp /= j) THEN
                    DO k=1,4
                        tmp     = a(j,k)
                        a(j,k)  = a(jp,k)
                        a(jp,k) = tmp
                    END DO
                END IF

                IF(ABS(a(j,j)) < tol) THEN
                    info = j
                ELSE
                    a(j+1:,j) = a(j+1:,j) * (1.d0/a(j,j))
                END IF

                DO k = j + 1, 4
                    a(j+1:,k) = a(j+1:,k) - a(j,k) * a(j+1:,j)
                END DO

            END DO
        ELSE

            jp = 1 - 1 + MAXLOC(ABS(a(1:,1)),dim=1)
            ipiv(1) = jp
            IF (jp /= 1) THEN
                swp(1:4) = a(1,1:4)
                a(1,1:4) = a(jp,1:4)
                a(jp,1:4) = swp(1:4)
            END IF

            IF(ABS(a(1,1)) < tol) THEN
                info = 1
            ELSE
                a(1+1:,1) = a(1+1:,1) * (1.d0/a(1,1))
            END IF

            DO k = 1 + 1, 4
                a(1+1:,k) = a(1+1:,k) - a(1,k) * a(1+1:,1)
            END DO

            jp = 2 - 1 + MAXLOC(ABS(a(2:,2)),dim=1)
            ipiv(2) = jp
            IF (jp /= 2) THEN
                swp(1:4) = a(2,1:4)
                a(2,1:4) = a(jp,1:4)
                a(jp,1:4) = swp(1:4)
            END IF

            IF(ABS(a(2,2)) < tol) THEN
                info = 2
            ELSE
                a(2+1:,2) = a(2+1:,2) * (1.d0/a(2,2))
            END IF

            DO k = 2 + 1, 4
                a(2+1:,k) = a(2+1:,k) - a(2,k) * a(2+1:,2)
            END DO

            jp = 3 - 1 + MAXLOC(ABS(a(3:,3)),dim=1)
            ipiv(3) = jp
            IF (jp /= 3) THEN
                swp(1:4) = a(3,1:4)
                a(3,1:4) = a(jp,1:4)
                a(jp,1:4) = swp(1:4)
            END IF

            IF(ABS(a(3,3)) < tol) THEN
                info = 3
            ELSE
                a(3+1:,3) = a(3+1:,3) * (1.d0/a(3,3))
            END IF

            DO k = 3 + 1, 4
                a(3+1:,k) = a(3+1:,k) - a(3,k) * a(3+1:,3)
            END DO


            ipiv(4) = 4

            IF(ABS(a(4,4)) < tol) THEN
                info = 4
            END IF

        ENDIF
    END SUBROUTINE lu_fact_4