Blame view
fvn_sparse/fvn_sparse.f90
22.3 KB
b93026039 git-svn-id: https... |
1 2 3 4 5 6 7 8 |
module fvn_sparse use fvn_common implicit none ! Sparse solving interface fvn_sparse_solve module procedure fvn_zl_sparse_solve,fvn_zi_sparse_solve,fvn_dl_sparse_solve,fvn_di_sparse_solve end interface fvn_sparse_solve |
2b83390c6 1) added fvn_spar... |
9 10 11 |
interface fvn_sparse_det module procedure fvn_zl_sparse_det,fvn_zi_sparse_det,fvn_dl_sparse_det,fvn_di_sparse_det end interface fvn_sparse_det |
b93026039 git-svn-id: https... |
12 |
contains |
aee8aaaf1 Added a function ... |
13 14 15 |
function umfpack_return_code(c) implicit none |
14c923613 Return explicit u... |
16 |
integer(kind=sp_kind), intent(in) :: c |
aee8aaaf1 Added a function ... |
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
character(len=80) :: umfpack_return_code select case(c) case(0) umfpack_return_code="UMFPACK_OK" case(1) umfpack_return_code="UMFPACK_WARNING_singular_matrix" case(2) umfpack_return_code="UMFPACK_WARNING_determinant_underflow" case(3) umfpack_return_code="UMFPACK_WARNING_determinant_overflow" case(-1) umfpack_return_code="UMFPACK_ERROR_out_of_memory" case(-3) umfpack_return_code="UMFPACK_ERROR_invalid_Numeric_object" case(-4) umfpack_return_code="UMFPACK_ERROR_invalid_Symbolic_object" case(-5) umfpack_return_code="UMFPACK_ERROR_argument_missing" case(-6) umfpack_return_code="UMFPACK_ERROR_n_nonpositive" case(-8) umfpack_return_code="UMFPACK_ERROR_invalid_matrix" case(-11) umfpack_return_code="UMFPACK_ERROR_different_pattern" case(-13) umfpack_return_code="UMFPACK_ERROR_invalid_system" case(-15) umfpack_return_code="UMFPACK_ERROR_invalid_permutation" case(-911) umfpack_return_code="UMFPACK_ERROR_internal_error" case(-17) umfpack_return_code="UMFPACK_ERROR_file_IO" case default umfpack_return_code="Unknown return code" end select end function |
14c923613 Return explicit u... |
53 |
|
b93026039 git-svn-id: https... |
54 55 56 57 58 59 60 61 62 63 64 65 66 |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SPARSE RESOLUTION ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! Sparse resolution is done by interfaçing Tim Davi's UMFPACK ! http://www.cise.ufl.edu/research/sparse/SuiteSparse/ ! Used packages from SuiteSparse : AMD,UMFPACK,UFconfig ! ! Solve Ax=B using UMFPACK ! ! Where A is a sparse matrix given in its triplet form |
4bd212285 Changed sparse ro... |
67 68 |
! T -> non zero elements (Tx and Tz for real and imaginary part if complex) ! Ti,Tj -> row and column index (0-based) of the given elt |
b93026039 git-svn-id: https... |
69 70 71 72 |
! n : rank of matrix A ! nz : number of non zero elts ! ! fvn_*_sparse_solve |
f6bacaf83 ChW 11/09: ANSI c... |
73 74 |
! * = zl : double complex + integer(kind=dp_kind) ! * = zi : double complex + integer(kind=sp_kind) |
b93026039 git-svn-id: https... |
75 |
! |
4bd212285 Changed sparse ro... |
76 |
subroutine fvn_zl_sparse_solve(n,nz,Tx,Tz,Ti,Tj,Bx,Bz,x,status,det) |
b93026039 git-svn-id: https... |
77 |
implicit none |
f6bacaf83 ChW 11/09: ANSI c... |
78 |
integer(kind=dp_kind), intent(in) :: n,nz |
4bd212285 Changed sparse ro... |
79 |
real(kind=dp_kind),dimension(nz),intent(in) :: Tx,Tz |
f6bacaf83 ChW 11/09: ANSI c... |
80 |
integer(kind=dp_kind),dimension(nz),intent(in) :: Ti,Tj |
4bd212285 Changed sparse ro... |
81 |
real(kind=dp_kind),dimension(n),intent(in) :: Bx,Bz |
f6bacaf83 ChW 11/09: ANSI c... |
82 83 |
complex(kind=dp_kind),dimension(n),intent(out) :: x integer(kind=dp_kind), intent(out) :: status |
c64a05f8a Sparse Determinan... |
84 |
real(kind=dp_kind), dimension(3), optional, intent(out) :: det |
f6bacaf83 ChW 11/09: ANSI c... |
85 |
|
f6bacaf83 ChW 11/09: ANSI c... |
86 87 88 |
real(kind=dp_kind),dimension(:),allocatable :: Ax,Az integer(kind=dp_kind),dimension(:),allocatable :: Ap,Ai integer(kind=dp_kind) :: symbolic,numeric |
4bd212285 Changed sparse ro... |
89 |
real(kind=dp_kind),dimension(:),allocatable :: xx,xz |
f6bacaf83 ChW 11/09: ANSI c... |
90 91 92 |
real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control integer(kind=dp_kind) :: sys |
b93026039 git-svn-id: https... |
93 94 95 |
status=0 |
b93026039 git-svn-id: https... |
96 97 98 99 |
allocate(Ax(nz),Az(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
100 |
call umfpack_zl_triplet_to_col(n,n,nz,Ti,Tj,Tx,Tz,Ap,Ai,Ax,Az,status) |
b93026039 git-svn-id: https... |
101 102 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
103 |
write(*,*) "Problem during umfpack_zl_triplet_to_col : ",trim(umfpack_return_code(int(status,kind=sp_kind))) |
b93026039 git-svn-id: https... |
104 105 106 107 108 109 110 111 112 |
endif ! Define defaults control values call umfpack_zl_defaults(control) ! Symbolic analysis call umfpack_zl_symbolic(n,n,Ap,Ai,Ax,Az,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
113 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
114 115 116 117 118 119 120 |
status=info(1) endif ! Numerical factorization call umfpack_zl_numeric (Ap, Ai, Ax, Az, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
121 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
122 123 124 125 126 |
status=info(1) endif ! free the C symbolic pointer call umfpack_zl_free_symbolic (symbolic) |
2b83390c6 1) added fvn_spar... |
127 128 |
! if parameter det is present, the determinant of the matrix is calculated if (present(det) ) then |
c64a05f8a Sparse Determinan... |
129 |
call umfpack_zl_get_determinant(det(1),det(2),det(3),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
130 131 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
132 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
133 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
134 |
endif |
2b83390c6 1) added fvn_spar... |
135 136 137 |
status=info(1) endif endif |
4bd212285 Changed sparse ro... |
138 |
allocate(xx(n),xz(n)) |
b93026039 git-svn-id: https... |
139 140 141 142 143 144 145 |
sys=0 ! sys may be used to define type of solving -> see umfpack.h ! Solving call umfpack_zl_solve (sys, Ap, Ai, Ax,Az, xx,xz, bx,bz, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
146 |
write(*,*) "Problem during solving : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
147 148 149 150 151 152 |
status=info(1) endif ! free the C numeric pointer call umfpack_zl_free_numeric (numeric) |
f6bacaf83 ChW 11/09: ANSI c... |
153 |
x=cmplx(xx,xz,dp_kind) |
b93026039 git-svn-id: https... |
154 |
|
4bd212285 Changed sparse ro... |
155 |
deallocate(xx,xz) |
b93026039 git-svn-id: https... |
156 |
deallocate(Ax,Az) |
b93026039 git-svn-id: https... |
157 |
end subroutine |
4bd212285 Changed sparse ro... |
158 |
subroutine fvn_zi_sparse_solve(n,nz,Tx,Tz,Ti,Tj,Bx,Bz,x,status,det) |
b93026039 git-svn-id: https... |
159 |
implicit none |
f6bacaf83 ChW 11/09: ANSI c... |
160 |
integer(kind=sp_kind), intent(in) :: n,nz |
4bd212285 Changed sparse ro... |
161 |
real(kind=dp_kind),dimension(nz),intent(in) :: Tx,Tz |
f6bacaf83 ChW 11/09: ANSI c... |
162 |
integer(kind=sp_kind),dimension(nz),intent(in) :: Ti,Tj |
4bd212285 Changed sparse ro... |
163 |
real(kind=dp_kind),dimension(n),intent(in) :: Bx,Bz |
f6bacaf83 ChW 11/09: ANSI c... |
164 165 |
complex(kind=dp_kind),dimension(n),intent(out) :: x integer(kind=sp_kind), intent(out) :: status |
c64a05f8a Sparse Determinan... |
166 |
real(kind=dp_kind), dimension(3), optional, intent(out) :: det |
f6bacaf83 ChW 11/09: ANSI c... |
167 |
|
f6bacaf83 ChW 11/09: ANSI c... |
168 169 170 171 |
real(kind=dp_kind),dimension(:),allocatable :: Ax,Az integer(kind=sp_kind),dimension(:),allocatable :: Ap,Ai !integer(kind=dp_kind) :: symbolic,numeric integer(kind=sp_kind),dimension(2) :: symbolic,numeric |
b93026039 git-svn-id: https... |
172 |
! As symbolic and numeric are used to store a C pointer, it is necessary to |
f6bacaf83 ChW 11/09: ANSI c... |
173 174 |
! still use an integer(kind=dp_kind) for 64bits machines ! An other possibility : integer(kind=sp_kind),dimension(2) :: symbolic,numeric |
4bd212285 Changed sparse ro... |
175 |
real(kind=dp_kind),dimension(:),allocatable :: xx,xz |
f6bacaf83 ChW 11/09: ANSI c... |
176 177 178 |
real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control integer(kind=sp_kind) :: sys |
b93026039 git-svn-id: https... |
179 180 |
status=0 |
b93026039 git-svn-id: https... |
181 182 183 184 |
allocate(Ax(nz),Az(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
185 |
call umfpack_zi_triplet_to_col(n,n,nz,Ti,Tj,Tx,Tz,Ap,Ai,Ax,Az,status) |
b93026039 git-svn-id: https... |
186 187 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
188 |
write(*,*) "Problem during umfpack_zl_triplet_to_col : ",trim(umfpack_return_code(status)) |
b93026039 git-svn-id: https... |
189 190 191 192 193 194 195 196 197 |
endif ! Define defaults control values call umfpack_zi_defaults(control) ! Symbolic analysis call umfpack_zi_symbolic(n,n,Ap,Ai,Ax,Az,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
198 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
199 200 201 202 203 204 205 |
status=info(1) endif ! Numerical factorization call umfpack_zi_numeric (Ap, Ai, Ax, Az, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
206 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
207 208 209 210 211 |
status=info(1) endif ! free the C symbolic pointer call umfpack_zi_free_symbolic (symbolic) |
2b83390c6 1) added fvn_spar... |
212 213 |
! if parameter det is present, the determinant of the matrix is calculated if (present(det) ) then |
c64a05f8a Sparse Determinan... |
214 |
call umfpack_zi_get_determinant(det(1),det(2),det(3),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
215 216 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
217 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
218 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
219 |
endif |
2b83390c6 1) added fvn_spar... |
220 221 222 |
status=info(1) endif endif |
4bd212285 Changed sparse ro... |
223 |
allocate(xx(n),xz(n)) |
b93026039 git-svn-id: https... |
224 225 226 227 228 229 230 |
sys=0 ! sys may be used to define type of solving -> see umfpack.h ! Solving call umfpack_zi_solve (sys, Ap, Ai, Ax,Az, xx,xz, bx,bz, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
231 |
write(*,*) "Problem during solving : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
232 233 234 235 236 |
status=info(1) endif ! free the C numeric pointer call umfpack_zi_free_numeric (numeric) |
f6bacaf83 ChW 11/09: ANSI c... |
237 |
x=cmplx(xx,xz,dp_kind) |
b93026039 git-svn-id: https... |
238 |
|
4bd212285 Changed sparse ro... |
239 |
deallocate(xx,xz) |
b93026039 git-svn-id: https... |
240 |
deallocate(Ax,Az) |
b93026039 git-svn-id: https... |
241 |
end subroutine |
2b83390c6 1) added fvn_spar... |
242 |
subroutine fvn_dl_sparse_solve(n,nz,T,Ti,Tj,B,x,status,det) |
b93026039 git-svn-id: https... |
243 |
implicit none |
f6bacaf83 ChW 11/09: ANSI c... |
244 245 246 247 248 249 |
integer(kind=dp_kind), intent(in) :: n,nz real(kind=dp_kind),dimension(nz),intent(in) :: T integer(kind=dp_kind),dimension(nz),intent(in) :: Ti,Tj real(kind=dp_kind),dimension(n),intent(in) :: B real(kind=dp_kind),dimension(n),intent(out) :: x integer(kind=dp_kind), intent(out) :: status |
c64a05f8a Sparse Determinan... |
250 |
real(kind=dp_kind), dimension(2), optional, intent(out) :: det |
f6bacaf83 ChW 11/09: ANSI c... |
251 |
|
f6bacaf83 ChW 11/09: ANSI c... |
252 253 254 255 256 257 258 |
real(kind=dp_kind),dimension(:),allocatable :: A integer(kind=dp_kind),dimension(:),allocatable :: Ap,Ai !integer(kind=dp_kind) :: symbolic,numeric integer(kind=dp_kind) :: symbolic,numeric real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control integer(kind=dp_kind) :: sys |
b93026039 git-svn-id: https... |
259 260 |
status=0 |
b93026039 git-svn-id: https... |
261 262 263 264 |
allocate(A(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
265 |
call umfpack_dl_triplet_to_col(n,n,nz,Ti,Tj,T,Ap,Ai,A,status) |
b93026039 git-svn-id: https... |
266 267 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
268 |
write(*,*) "Problem during umfpack_dl_triplet_to_col : ",trim(umfpack_return_code(int(status,kind=sp_kind))) |
b93026039 git-svn-id: https... |
269 270 271 272 273 274 275 276 277 |
endif ! Define defaults control values call umfpack_dl_defaults(control) ! Symbolic analysis call umfpack_dl_symbolic(n,n,Ap,Ai,A,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
278 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
279 280 281 282 283 284 285 |
status=info(1) endif ! Numerical factorization call umfpack_dl_numeric (Ap, Ai, A, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
286 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
287 288 289 290 291 |
status=info(1) endif ! free the C symbolic pointer call umfpack_dl_free_symbolic (symbolic) |
2b83390c6 1) added fvn_spar... |
292 293 |
! if parameter det is present, the determinant of the matrix is calculated if (present(det) ) then |
c64a05f8a Sparse Determinan... |
294 |
call umfpack_dl_get_determinant(det(1),det(2),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
295 296 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
297 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
298 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
299 |
endif |
2b83390c6 1) added fvn_spar... |
300 301 302 |
status=info(1) endif endif |
b93026039 git-svn-id: https... |
303 304 305 306 307 308 309 |
sys=0 ! sys may be used to define type of solving -> see umfpack.h ! Solving call umfpack_dl_solve (sys, Ap, Ai, A, x, B, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
310 |
write(*,*) "Problem during solving : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
311 312 313 314 315 316 317 |
status=info(1) endif ! free the C numeric pointer call umfpack_dl_free_numeric (numeric) deallocate(A) |
b93026039 git-svn-id: https... |
318 |
end subroutine |
2b83390c6 1) added fvn_spar... |
319 |
subroutine fvn_di_sparse_solve(n,nz,T,Ti,Tj,B,x,status,det) |
b93026039 git-svn-id: https... |
320 |
implicit none |
f6bacaf83 ChW 11/09: ANSI c... |
321 322 323 324 325 326 |
integer(kind=sp_kind), intent(in) :: n,nz real(kind=dp_kind),dimension(nz),intent(in) :: T integer(kind=sp_kind),dimension(nz),intent(in) :: Ti,Tj real(kind=dp_kind),dimension(n),intent(in) :: B real(kind=dp_kind),dimension(n),intent(out) :: x integer(kind=sp_kind), intent(out) :: status |
c64a05f8a Sparse Determinan... |
327 |
real(kind=dp_kind), dimension(2), optional, intent(out) :: det |
f6bacaf83 ChW 11/09: ANSI c... |
328 |
|
f6bacaf83 ChW 11/09: ANSI c... |
329 330 331 332 |
real(kind=dp_kind),dimension(:),allocatable :: A integer(kind=sp_kind),dimension(:),allocatable :: Ap,Ai !integer(kind=dp_kind) :: symbolic,numeric integer(kind=sp_kind),dimension(2) :: symbolic,numeric |
b93026039 git-svn-id: https... |
333 |
! As symbolic and numeric are used to store a C pointer, it is necessary to |
f6bacaf83 ChW 11/09: ANSI c... |
334 335 336 337 338 |
! still use an integer(kind=dp_kind) for 64bits machines ! An other possibility : integer(kind=sp_kind),dimension(2) :: symbolic,numeric real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control integer(kind=sp_kind) :: sys |
b93026039 git-svn-id: https... |
339 340 |
status=0 |
b93026039 git-svn-id: https... |
341 342 343 344 |
allocate(A(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
345 |
call umfpack_di_triplet_to_col(n,n,nz,Ti,Tj,T,Ap,Ai,A,status) |
b93026039 git-svn-id: https... |
346 347 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
348 |
write(*,*) "Problem during umfpack_di_triplet_to_col : ",trim(umfpack_return_code(status)) |
b93026039 git-svn-id: https... |
349 350 351 352 353 354 355 356 357 |
endif ! Define defaults control values call umfpack_di_defaults(control) ! Symbolic analysis call umfpack_di_symbolic(n,n,Ap,Ai,A,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
358 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
359 360 361 362 363 364 365 |
status=info(1) endif ! Numerical factorization call umfpack_di_numeric (Ap, Ai, A, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
366 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
367 368 369 370 371 |
status=info(1) endif ! free the C symbolic pointer call umfpack_di_free_symbolic (symbolic) |
2b83390c6 1) added fvn_spar... |
372 373 |
! if parameter det is present, the determinant of the matrix is calculated if (present(det) ) then |
c64a05f8a Sparse Determinan... |
374 |
call umfpack_di_get_determinant(det(1),det(2),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
375 376 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
377 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
378 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
379 |
endif |
2b83390c6 1) added fvn_spar... |
380 381 382 |
status=info(1) endif endif |
b93026039 git-svn-id: https... |
383 384 |
sys=0 ! sys may be used to define type of solving -> see umfpack.h |
b93026039 git-svn-id: https... |
385 386 387 388 |
! Solving call umfpack_di_solve (sys, Ap, Ai, A, x, B, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
389 |
write(*,*) "Problem during solving : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
b93026039 git-svn-id: https... |
390 391 392 393 394 395 396 |
status=info(1) endif ! free the C numeric pointer call umfpack_di_free_numeric (numeric) deallocate(A) |
b93026039 git-svn-id: https... |
397 |
end subroutine |
2b83390c6 1) added fvn_spar... |
398 399 400 401 402 |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SPARSE DETERMINANT ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
4bd212285 Changed sparse ro... |
403 |
subroutine fvn_zl_sparse_det(n,nz,Tx,Tz,Ti,Tj,det,status) |
2b83390c6 1) added fvn_spar... |
404 405 |
implicit none integer(kind=dp_kind), intent(in) :: n,nz |
4bd212285 Changed sparse ro... |
406 |
real(kind=dp_kind),dimension(nz),intent(in) :: Tx,Tz |
2b83390c6 1) added fvn_spar... |
407 |
integer(kind=dp_kind),dimension(nz),intent(in) :: Ti,Tj |
c64a05f8a Sparse Determinan... |
408 |
real(kind=dp_kind), dimension(3), intent(out) :: det |
2b83390c6 1) added fvn_spar... |
409 |
integer(kind=dp_kind), intent(out) :: status |
2b83390c6 1) added fvn_spar... |
410 411 412 413 414 415 416 417 418 |
real(kind=dp_kind),dimension(:),allocatable :: Ax,Az integer(kind=dp_kind),dimension(:),allocatable :: Ap,Ai integer(kind=dp_kind) :: symbolic,numeric real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control real(kind=dp_kind) :: Mx,Mz,Ex status=0 |
2b83390c6 1) added fvn_spar... |
419 420 421 422 |
allocate(Ax(nz),Az(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
423 |
call umfpack_zl_triplet_to_col(n,n,nz,Ti,Tj,Tx,Tz,Ap,Ai,Ax,Az,status) |
2b83390c6 1) added fvn_spar... |
424 425 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
426 |
write(*,*) "Problem during umfpack_zl_triplet_to_col ",trim(umfpack_return_code(int(status,kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
427 428 429 430 431 432 433 434 435 |
endif ! Define defaults control values call umfpack_zl_defaults(control) ! Symbolic analysis call umfpack_zl_symbolic(n,n,Ap,Ai,Ax,Az,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
436 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
437 438 439 440 441 442 443 |
status=info(1) endif ! Numerical factorization call umfpack_zl_numeric (Ap, Ai, Ax, Az, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
444 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
445 446 447 448 449 |
status=info(1) endif ! free the C symbolic pointer call umfpack_zl_free_symbolic (symbolic) |
c64a05f8a Sparse Determinan... |
450 |
call umfpack_zl_get_determinant(det(1),det(2),det(3),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
451 452 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
453 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
454 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
455 |
endif |
2b83390c6 1) added fvn_spar... |
456 457 |
status=info(1) endif |
2b83390c6 1) added fvn_spar... |
458 459 460 461 462 |
! free the C numeric pointer call umfpack_zl_free_numeric (numeric) deallocate(Ax,Az) |
2b83390c6 1) added fvn_spar... |
463 |
end subroutine |
4bd212285 Changed sparse ro... |
464 |
subroutine fvn_zi_sparse_det(n,nz,Tx,Tz,Ti,Tj,det,status) |
2b83390c6 1) added fvn_spar... |
465 466 |
implicit none integer(kind=sp_kind), intent(in) :: n,nz |
4bd212285 Changed sparse ro... |
467 |
real(kind=dp_kind),dimension(nz),intent(in) :: Tx,Tz |
2b83390c6 1) added fvn_spar... |
468 469 |
integer(kind=sp_kind),dimension(nz),intent(in) :: Ti,Tj integer(kind=sp_kind), intent(out) :: status |
c64a05f8a Sparse Determinan... |
470 |
real(kind=dp_kind), dimension(3), intent(out) :: det |
2b83390c6 1) added fvn_spar... |
471 |
|
2b83390c6 1) added fvn_spar... |
472 473 474 475 476 477 478 479 480 |
real(kind=dp_kind),dimension(:),allocatable :: Ax,Az integer(kind=sp_kind),dimension(:),allocatable :: Ap,Ai !integer(kind=dp_kind) :: symbolic,numeric integer(kind=sp_kind),dimension(2) :: symbolic,numeric ! As symbolic and numeric are used to store a C pointer, it is necessary to ! still use an integer(kind=dp_kind) for 64bits machines ! An other possibility : integer(kind=sp_kind),dimension(2) :: symbolic,numeric real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control |
2b83390c6 1) added fvn_spar... |
481 482 |
status=0 |
2b83390c6 1) added fvn_spar... |
483 484 485 486 |
allocate(Ax(nz),Az(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
487 |
call umfpack_zi_triplet_to_col(n,n,nz,Ti,Tj,Tx,Tz,Ap,Ai,Ax,Az,status) |
2b83390c6 1) added fvn_spar... |
488 489 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
490 |
write(*,*) "Problem during umfpack_zl_triplet_to_col : ",trim(umfpack_return_code(status)) |
2b83390c6 1) added fvn_spar... |
491 492 493 494 495 496 497 498 499 |
endif ! Define defaults control values call umfpack_zi_defaults(control) ! Symbolic analysis call umfpack_zi_symbolic(n,n,Ap,Ai,Ax,Az,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
500 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
501 502 503 504 505 506 507 |
status=info(1) endif ! Numerical factorization call umfpack_zi_numeric (Ap, Ai, Ax, Az, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
508 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
509 510 511 512 513 |
status=info(1) endif ! free the C symbolic pointer call umfpack_zi_free_symbolic (symbolic) |
c64a05f8a Sparse Determinan... |
514 |
call umfpack_zi_get_determinant(det(1),det(2),det(3),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
515 516 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
517 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
518 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
519 |
endif |
2b83390c6 1) added fvn_spar... |
520 521 |
status=info(1) endif |
2b83390c6 1) added fvn_spar... |
522 523 524 525 526 |
! free the C numeric pointer call umfpack_zi_free_numeric (numeric) deallocate(Ax,Az) |
2b83390c6 1) added fvn_spar... |
527 528 529 530 531 532 533 534 |
end subroutine subroutine fvn_dl_sparse_det(n,nz,T,Ti,Tj,det,status) implicit none integer(kind=dp_kind), intent(in) :: n,nz real(kind=dp_kind),dimension(nz),intent(in) :: T integer(kind=dp_kind),dimension(nz),intent(in) :: Ti,Tj integer(kind=dp_kind), intent(out) :: status |
c64a05f8a Sparse Determinan... |
535 |
real(kind=dp_kind), dimension(2), intent(out) :: det |
2b83390c6 1) added fvn_spar... |
536 |
|
2b83390c6 1) added fvn_spar... |
537 538 539 540 541 542 |
real(kind=dp_kind),dimension(:),allocatable :: A integer(kind=dp_kind),dimension(:),allocatable :: Ap,Ai !integer(kind=dp_kind) :: symbolic,numeric integer(kind=dp_kind) :: symbolic,numeric real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control |
2b83390c6 1) added fvn_spar... |
543 544 |
status=0 |
2b83390c6 1) added fvn_spar... |
545 546 547 548 |
allocate(A(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
549 |
call umfpack_dl_triplet_to_col(n,n,nz,Ti,Tj,T,Ap,Ai,A,status) |
2b83390c6 1) added fvn_spar... |
550 551 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
552 |
write(*,*) "Problem during umfpack_dl_triplet_to_col : ",trim(umfpack_return_code(int(status,kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
553 554 555 556 557 558 559 560 561 |
endif ! Define defaults control values call umfpack_dl_defaults(control) ! Symbolic analysis call umfpack_dl_symbolic(n,n,Ap,Ai,A,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
562 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
563 564 565 566 567 568 569 |
status=info(1) endif ! Numerical factorization call umfpack_dl_numeric (Ap, Ai, A, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
570 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
571 572 573 574 575 |
status=info(1) endif ! free the C symbolic pointer call umfpack_dl_free_symbolic (symbolic) |
c64a05f8a Sparse Determinan... |
576 |
call umfpack_dl_get_determinant(det(1),det(2),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
577 578 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
579 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
580 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
581 |
endif |
2b83390c6 1) added fvn_spar... |
582 583 |
status=info(1) endif |
2b83390c6 1) added fvn_spar... |
584 585 586 587 588 |
! free the C numeric pointer call umfpack_dl_free_numeric (numeric) deallocate(A) |
2b83390c6 1) added fvn_spar... |
589 590 591 592 593 594 595 596 597 |
end subroutine subroutine fvn_di_sparse_det(n,nz,T,Ti,Tj,det,status) implicit none integer(kind=sp_kind), intent(in) :: n,nz real(kind=dp_kind),dimension(nz),intent(in) :: T integer(kind=sp_kind),dimension(nz),intent(in) :: Ti,Tj integer(kind=sp_kind), intent(out) :: status |
c64a05f8a Sparse Determinan... |
598 |
real(kind=dp_kind), dimension(2), intent(out) :: det |
2b83390c6 1) added fvn_spar... |
599 |
|
2b83390c6 1) added fvn_spar... |
600 601 602 603 604 605 606 607 608 609 |
real(kind=dp_kind),dimension(:),allocatable :: A integer(kind=sp_kind),dimension(:),allocatable :: Ap,Ai !integer(kind=dp_kind) :: symbolic,numeric integer(kind=sp_kind),dimension(2) :: symbolic,numeric ! As symbolic and numeric are used to store a C pointer, it is necessary to ! still use an integer(kind=dp_kind) for 64bits machines ! An other possibility : integer(kind=sp_kind),dimension(2) :: symbolic,numeric real(kind=dp_kind),dimension(90) :: info real(kind=dp_kind),dimension(20) :: control integer(kind=sp_kind) :: sys |
2b83390c6 1) added fvn_spar... |
610 611 612 |
status=0 |
2b83390c6 1) added fvn_spar... |
613 614 615 616 |
allocate(A(nz)) allocate(Ap(n+1),Ai(nz)) ! perform the triplet to compressed column form -> Ap,Ai,Ax,Az |
4bd212285 Changed sparse ro... |
617 |
call umfpack_di_triplet_to_col(n,n,nz,Ti,Tj,T,Ap,Ai,A,status) |
2b83390c6 1) added fvn_spar... |
618 619 |
! if status is not zero a problem has occured if (status /= 0) then |
7dc628d15 Added error outpu... |
620 |
write(*,*) "Problem during umfpack_di_triplet_to_col : ",trim(umfpack_return_code(status)) |
2b83390c6 1) added fvn_spar... |
621 622 623 624 625 626 627 628 629 |
endif ! Define defaults control values call umfpack_di_defaults(control) ! Symbolic analysis call umfpack_di_symbolic(n,n,Ap,Ai,A,symbolic, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
630 |
write(*,*) "Problem during symbolic analysis : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
631 632 633 634 635 636 637 |
status=info(1) endif ! Numerical factorization call umfpack_di_numeric (Ap, Ai, A, symbolic, numeric, control, info) ! info(1) should be zero if (info(1) /= 0) then |
7dc628d15 Added error outpu... |
638 |
write(*,*) "Problem during numerical factorization : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
2b83390c6 1) added fvn_spar... |
639 640 641 642 643 644 |
status=info(1) endif ! free the C symbolic pointer call umfpack_di_free_symbolic (symbolic) |
c64a05f8a Sparse Determinan... |
645 |
call umfpack_di_get_determinant(det(1),det(2),numeric,info,status) |
2b83390c6 1) added fvn_spar... |
646 647 |
! info(1) should be zero if (info(1) /= 0) then |
ba393a269 1) updated docume... |
648 |
if ( (info(1) < 1) .or. (info(1) >3) ) then ! not a warning |
7dc628d15 Added error outpu... |
649 |
write(*,*) "Problem during sparse determinant : ",trim(umfpack_return_code(int(info(1),kind=sp_kind))) |
ba393a269 1) updated docume... |
650 |
endif |
2b83390c6 1) added fvn_spar... |
651 652 653 654 655 656 657 |
status=info(1) endif ! free the C numeric pointer call umfpack_di_free_numeric (numeric) deallocate(A) |
2b83390c6 1) added fvn_spar... |
658 |
end subroutine |
b93026039 git-svn-id: https... |
659 |
end module fvn_sparse |