Note
Subroutine to solve the system
true
FACTORED
1
)SAMEPATTERN
Warning
At the end, the memory is released with the dstruction of sml and smu
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=R8), | intent(inout), | dimension(:) | :: | sol_x | ||
type(SULU_ENV), | intent(inout) | :: | sulu | |||
logical(kind=I4), | intent(in) | :: | verbose |
subroutine solv_superlu(sol_x, sulu, verbose) implicit none real(kind=R8), dimension(:), intent(inout) :: sol_x type(SULU_ENV), intent(inout) :: sulu logical(kind=I4), intent(in) :: verbose type(NCFORMAT), pointer :: Xstore real(kind=R8), pointer :: tabX(:) integer(kind=I4) :: i call StatInit(sulu%stat) if ( sulu%first ) then sulu%options%Fact = FACTORED sulu%SMB%ncol = sulu%nrhs else sulu%options%Fact = SAMEPATTERN call prep_superlu(sulu) endif call dgssvx( options = sulu%options, & ! superlu_options_t *options A = sulu%SMA, & ! SuperMatrix *A perm_c = sulu%perm_c, & ! int *perm_c perm_r = sulu%perm_r, & ! int *perm_r etree = sulu%etree , & ! int *etree equed = sulu%equed, & ! char *equed R = sulu%RR, & ! double *R C = sulu%CC, & ! double *C L = sulu%SML, & ! SuperMatrix *L U = sulu%SMU, & ! SuperMatrix *U work = sulu%work, & ! void *work lwork = sulu%lwork, & ! int lwork B = sulu%SMB, & ! SuperMatrix *B X = sulu%SMX, & ! SuperMatrix *X recip_pivot_growth = sulu%rpg, & ! double *recip_pivot_growth rcond = sulu%rcond, & ! double *rcond ferr = sulu%ferr, & ! double *ferr berr = sulu%berr, & ! double *berr Glu = sulu%Glu, & ! GlobalLU_t *Glu mem_usage = sulu%mem_usage, & ! mem_usage_t *mem_usage stat = sulu%stat, & ! SuperLUStat_t *stat info = sulu%info & ! int *info ) call c_f_pointer(sulu%SMX%Store, XStore) call c_f_pointer(XStore%nzval, tabX, [XStore%nnz]) do i = 1, sulu%n sol_x(i) = tabX(i) enddo nullify(Xstore, tabX) if (verbose) call StatPrint(sulu%stat) call StatFree(sulu%stat) call Destroy_SuperNode_Matrix(sulu%SML) call Destroy_CompCol_Matrix( sulu%SMU) return endsubroutine solv_superlu