lxsd / fvn | GitLab

Commit 2b83390c62d2805fd4b83574ddd5e47178368fb3

Authored by wdaniau 2009-12-08 09:12:25 +0100

Exists in master and in 3 other branches

1) added fvn_sparse_det routine to compute determinant of a sparse matrix

2) added optional parameter det to fvn_sparse_solve to compute determinant
during solving
3) split the test_sparse.f90 into 4 files to test each specific interface

git-svn-id: https://lxsd.femto-st.fr/svn/fvn@64 b657c933-2333-4658-acf2-d3c7c2708721

Showing 8 changed files with 612 additions and 42 deletions Inline Diff

fvn_sparse/fvn_sparse.f90
fvn_sparse/umfpack_wrapper.c
fvn_test/Makefile
fvn_test/test_sparse.f90
fvn_test/test_sparse_di.f90
fvn_test/test_sparse_dl.f90
fvn_test/test_sparse_zi.f90
fvn_test/test_sparse_zl.f90

fvn_sparse/fvn_sparse.f90

Diff comments View file @ 2b83390

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

fvn_sparse/umfpack_wrapper.c

Diff comments View file @ 2b83390

fvn_test/Makefile

Diff comments View file @ 2b83390

	1	1
include $(BTREE)/Make.inc	2	2	include $(BTREE)/Make.inc
	3	3
programs = test_fac$(exext) test_matinv$(exext) test_specfunc$(exext) \	4	4	programs = test_fac$(exext) test_matinv$(exext) test_specfunc$(exext) \
test_det$(exext) test_matcon$(exext) test_matev$(exext) test_sparse$(exext) test_inter1d$(exext) \	5	5	test_det$(exext) test_matcon$(exext) test_matev$(exext) test_inter1d$(exext) \
test_inter2d$(exext) test_inter3d$(exext) test_akima$(exext) test_lsp$(exext) test_muller$(exext) \	6	6	test_inter2d$(exext) test_inter3d$(exext) test_akima$(exext) test_lsp$(exext) test_muller$(exext) \
test_integ$(exext) test_bsyn$(exext) test_bsjn$(exext) test_bskn$(exext) test_bsin$(exext) test_operators$(exext) test_ze1$(exext) \	7	7	test_integ$(exext) test_bsyn$(exext) test_bsjn$(exext) test_bskn$(exext) test_bsin$(exext) test_operators$(exext) test_ze1$(exext) \
test_besri$(exext) test_besrj$(exext) test_bestime$(exext)	8	8	test_besri$(exext) test_besrj$(exext) test_bestime$(exext) \
		9	test_sparse_zi$(exext) test_sparse_zl$(exext) test_sparse_di$(exext) test_sparse_dl$(exext)
	9	10
prog:$(programs)	10	11	prog:$(programs)
	11	12
clean:	12	13	clean:
rm -f {.o,.oo,.ipo,.a,.mod,.dat}	13	14	rm -f {.o,.oo,.ipo,.a,.mod,.dat}
rm -f $(programs)	14	15	rm -f $(programs)
	15	16
%$(exext): %.o	16	17	%$(exext): %.o
$(LINK) $(LINKFLAGS) $< init_random_seed.o $(LINKFVN) -o $@	17	18	$(LINK) $(LINKFLAGS) $< init_random_seed.o $(LINKFVN) -o $@

fvn_test/test_sparse.f90

View file @ 2b83390

program test_sparse	1	File was deleted
use fvn_sparse	2
implicit none	3
integer(kind=ip_kind), parameter :: nz=12	4
integer(kind=ip_kind), parameter :: n=5	5
real(kind=dp_kind),dimension(nz) :: A	6
real(kind=dp_kind),dimension(n,n) :: As	7
integer(kind=ip_kind),dimension(nz) :: Ti,Tj	8
real(kind=dp_kind),dimension(n) :: B,x	9
integer(kind=ip_kind) :: status,i	10
! Description of the matrix in triplet form	11
A = (/ 2.,3.,3.,-1.,4.,4.,-3.,1.,2.,2.,6.,1. /)	12
B = (/ 8., 45., -3., 3., 19./)	13
Ti = (/ 1,2,1,3,5,2,3,4,5,3,2,5 /)	14
Tj = (/ 1,1,2,2,2,3,3,3,3,4,5,5 /)	15
	16
! Reconstruction of the matrix in standard form	17
! just needed for printing the matrix here	18
As=0.	19
do i=1,nz	20
As(Ti(i),Tj(i))=A(i)	21
end do	22
write(,) "Matrix in standard representation :"	23
do i=1,5	24
write(*,'(5f8.4)') As(i,:)	25
end do	26
write(,)	27
write(*,'("Right hand side :",5f8.4)') B	28
	29
!specific routine that will be used here	30
!call fvn_di_sparse_solve(n,nz,A,Ti,Tj,B,x,status)	31
call fvn_di_sparse_solve(n,nz,A,Ti,Tj,B,x,status)	32
write(*,'("Solution :",5f8.4)') x	33

fvn_test/test_sparse_di.f90

Diff comments View file @ 2b83390

File was created	1	program test_sparse
	2	! test sparse routine di, real(8) and integer(4)
	3	use fvn
	4	implicit none
	5	integer(kind=sp_kind), parameter :: nz=12
	6	integer(kind=sp_kind), parameter :: n=5
	7	real(kind=dp_kind),dimension(nz) :: A
	8	real(kind=dp_kind),dimension(n,n) :: As
	9	integer(kind=sp_kind),dimension(nz) :: Ti,Tj
	10	real(kind=dp_kind),dimension(n) :: B,x
	11	integer(kind=sp_kind) :: status,i
	12	real(kind=dp_kind) :: det
	13	! Description of the matrix in triplet form
	14	A = (/ 2.,3.,3.,-1.,4.,4.,-3.,1.,2.,2.,6.,1. /)
	15	B = (/ 8., 45., -3., 3., 19./)
	16	Ti = (/ 1,2,1,3,5,2,3,4,5,3,2,5 /)
	17	Tj = (/ 1,1,2,2,2,3,3,3,3,4,5,5 /)
	18
	19	! Reconstruction of the matrix in standard form
	20	! just needed for printing the matrix here
	21	As=0.
	22	do i=1,nz
	23	As(Ti(i),Tj(i))=A(i)
	24	end do
	25	write(,) "Matrix in standard representation :"
	26	do i=1,5
	27	write(*,'(5f8.4)') As(i,:)
	28	end do
	29	write(,)
	30	write(,) "Standard determinant =", fvn_det(5,As)
	31	write(,)
	32	write(*,'("Right hand side :",5f8.4)') B
	33
	34	! can use either specific interface, fvn_di_sparse_det
	35	! either generic one fvn_sparse_det
	36	call fvn_di_sparse_det(n,nz,A,Ti,Tj,det,status)
	37	write(,)
	38	write(,) "Sparse Det = ",det
	39	! can use either specific interface fvn_di_sparse_solve
	40	! either generic one fvn_sparse_solve
	41	! parameter det is optional
	42	call fvn_di_sparse_solve(n,nz,A,Ti,Tj,B,x,status,det)
	43	write(,)
	44	write(,) "Sparse Det as solve option = ",det
	45	write(,)
	46	write(*,'("Solution :",5f8.4)') x
	47	write(,)

fvn_test/test_sparse_dl.f90

Diff comments View file @ 2b83390

File was created	1	program test_sparse
	2	! test sparse routine dl, real(8) and integer(8)
	3	use fvn
	4	implicit none
	5	integer(kind=dp_kind), parameter :: nz=12
	6	integer(kind=dp_kind), parameter :: n=5
	7	real(kind=dp_kind),dimension(nz) :: A
	8	real(kind=dp_kind),dimension(n,n) :: As
	9	integer(kind=dp_kind),dimension(nz) :: Ti,Tj
	10	real(kind=dp_kind),dimension(n) :: B,x
	11	integer(kind=dp_kind) :: status,i
	12	real(kind=dp_kind) :: det
	13	! Description of the matrix in triplet form
	14	A = (/ 2.,3.,3.,-1.,4.,4.,-3.,1.,2.,2.,6.,1. /)
	15	B = (/ 8., 45., -3., 3., 19./)
	16	Ti = (/ 1,2,1,3,5,2,3,4,5,3,2,5 /)
	17	Tj = (/ 1,1,2,2,2,3,3,3,3,4,5,5 /)
	18
	19	! Reconstruction of the matrix in standard form
	20	! just needed for printing the matrix here
	21	As=0.
	22	do i=1,nz
	23	As(Ti(i),Tj(i))=A(i)
	24	end do
	25	write(,) "Matrix in standard representation :"
	26	do i=1,5
	27	write(*,'(5f8.4)') As(i,:)
	28	end do
	29	write(,)
	30	write(,) "Standard determinant =", fvn_det(5,As)
	31	write(,)
	32	write(*,'("Right hand side :",5f8.4)') B
	33
	34	! can use either specific interface, fvn_dl_sparse_det
	35	! either generic one fvn_sparse_det
	36	call fvn_dl_sparse_det(n,nz,A,Ti,Tj,det,status)
	37	write(,)
	38	write(,) "Sparse Det = ",det
	39	! can use either specific interface fvn_dl_sparse_solve
	40	! either generic one fvn_sparse_solve
	41	! parameter det is optional
	42	call fvn_dl_sparse_solve(n,nz,A,Ti,Tj,B,x,status,det)
	43	write(,)
	44	write(,) "Sparse Det as solve option = ",det
	45	write(,)
	46	write(*,'("Solution :",5f8.4)') x
	47	write(,)

fvn_test/test_sparse_zi.f90

Diff comments View file @ 2b83390

File was created	1	program test_sparse
	2	use fvn
	3	implicit none
	4	integer(kind=sp_kind), parameter :: nz=12
	5	integer(kind=sp_kind), parameter :: n=5
	6	complex(kind=dp_kind),dimension(nz) :: A
	7	complex(kind=dp_kind),dimension(n,n) :: As
	8	integer(kind=sp_kind),dimension(nz) :: Ti,Tj
	9	complex(kind=dp_kind),dimension(n) :: B,x
	10	integer(kind=sp_kind) :: status,i
	11	complex(kind=dp_kind) :: det
	12	character(len=80) :: fmcmplx
	13
	14	fmcmplx='(5("(",f8.5,",",f8.5,") "))'
	15
	16	! Description of the matrix in triplet form
	17	A = (/ (2.,-1.),(3.,2.),(3.,1.),(-1.,5.),(4.,-7.),(4.,0.),(-3.,-4.),(1.,3.),(2.,0.),(2.,-2.),(6.,4.),(1.,0.) /)
	18	B = (/ (8.,3.), (45.,1.), (-3.,-2.), (3.,0.), (19.,2.) /)
	19	Ti = (/ 1,2,1,3,5,2,3,4,5,3,2,5 /)
	20	Tj = (/ 1,1,2,2,2,3,3,3,3,4,5,5 /)
	21
	22	! Reconstruction of the matrix in standard form
	23	As=0.
	24	do i=1,nz
	25	As(Ti(i),Tj(i))=A(i)
	26	end do
	27
	28	write(,) "Matrix in standard representation :"
	29	do i=1,5
	30	write(*,fmcmplx) As(i,:)
	31	end do
	32	write(,)
	33	write(,) "Standard determinant : ",fvn_det(5,As)
	34	write(,)
	35	write(,) "Right hand side :"
	36	write(*,fmcmplx) B
	37
	38	! can use either specific interface, fvn_zi_sparse_det
	39	! either generic one fvn_sparse_det
	40	call fvn_zi_sparse_det(n,nz,A,Ti,Tj,det,status)
	41	write(,)
	42	write(,) "Sparse Det = ",det
	43	! can use either specific interface fvn_zi_sparse_solve
	44	! either generic one fvn_sparse_solve
	45	! parameter det is optional
	46	call fvn_zi_sparse_solve(n,nz,A,Ti,Tj,B,x,status,det)
	47	write(,)
	48	write(,) "Sparse Det as solve option= ",det
	49	write(,)
	50	write(,) "Solution :"

fvn_test/test_sparse_zl.f90

Diff comments View file @ 2b83390

File was created	1	program test_sparse
	2	! test sparse routine zl, complex(8) and integer(8)
	3	use fvn
	4	implicit none
	5	integer(kind=dp_kind), parameter :: nz=12
	6	integer(kind=dp_kind), parameter :: n=5
	7	complex(kind=dp_kind),dimension(nz) :: A
	8	complex(kind=dp_kind),dimension(n,n) :: As
	9	integer(kind=dp_kind),dimension(nz) :: Ti,Tj
	10	complex(kind=dp_kind),dimension(n) :: B,x
	11	integer(kind=dp_kind) :: status,i
	12	complex(kind=dp_kind) :: det
	13	character(len=80) :: fmcmplx
	14
	15	fmcmplx='(5("(",f8.5,",",f8.5,") "))'
	16
	17	! Description of the matrix in triplet form
	18	A = (/ (2.,-1.),(3.,2.),(3.,1.),(-1.,5.),(4.,-7.),(4.,0.),(-3.,-4.),(1.,3.),(2.,0.),(2.,-2.),(6.,4.),(1.,0.) /)
	19	B = (/ (8.,3.), (45.,1.), (-3.,-2.), (3.,0.), (19.,2.) /)
	20	Ti = (/ 1,2,1,3,5,2,3,4,5,3,2,5 /)
	21	Tj = (/ 1,1,2,2,2,3,3,3,3,4,5,5 /)
	22
	23	! Reconstruction of the matrix in standard form
	24	As=0.
	25	do i=1,nz
	26	As(Ti(i),Tj(i))=A(i)
	27	end do
	28
	29	write(,) "Matrix in standard representation :"
	30	do i=1,5
	31	write(*,fmcmplx) As(i,:)
	32	end do
	33	write(,)
	34	write(,) "Standard determinant : ",fvn_det(5,As)
	35	write(,)
	36	write(,) "Right hand side :"
	37	write(*,fmcmplx) B
	38	! can use either specific interface, fvn_zl_sparse_det
	39	! either generic one fvn_sparse_det
	40	call fvn_zl_sparse_det(n,nz,A,Ti,Tj,det,status)
	41	write(,)
	42	write(,) "Sparse Det = ",det
	43	! can use either specific interface fvn_zl_sparse_solve
	44	! either generic one fvn_sparse_solve
	45	! parameter det is optional
	46	call fvn_zl_sparse_solve(n,nz,A,Ti,Tj,B,x,status,det)
	47	write(,)
	48	write(,) "Sparse Det as solve option= ",det
	49	write(,)
	50	write(,) "Solution :"
	51	write(*,fmcmplx) x

#include "umfpack.h"	1	1	#include "umfpack.h"
#include <ctype.h>	2	2	#include <ctype.h>
#include <stdio.h>	3	3	#include <stdio.h>
#ifdef NULL	4	4	#ifdef NULL
#undef NULL	5	5	#undef NULL
#endif	6	6	#endif
#define NULL 0	7	7	#define NULL 0
#define LEN 200	8	8	#define LEN 200
	9	9
/* for umfpack 4.1 */	10	10	/* for umfpack 4.1 */
/* #define UF_long long */	11	11	/* #define UF_long long */
/*	12	12	/*
	13	13
set of routines used by fvn_sparse	14	14	set of routines used by fvn_sparse
	15	15
complex(8) and integer(8)	16	16	complex(8) and integer(8)
	17	17
*/	18	18	*/
	19	19
/* defaults */	20	20	/* defaults */
	21	21
void umfpack_zl_defaults_ (double Control [UMFPACK_CONTROL])	22	22	void umfpack_zl_defaults_ (double Control [UMFPACK_CONTROL])
{	23	23	{
umfpack_zl_defaults (Control) ;	24	24	umfpack_zl_defaults (Control) ;
}	25	25	}
	26	26
/* free the Numeric object */	27	27	/* free the Numeric object */
void umfpack_zl_free_numeric_(void **Numeric)	28	28	void umfpack_zl_free_numeric_(void **Numeric)
{	29	29	{
umfpack_zl_free_numeric (Numeric) ;	30	30	umfpack_zl_free_numeric (Numeric) ;
}	31	31	}
	32	32
/* free th Symbolic object */	33	33	/* free th Symbolic object */
void umfpack_zl_free_symbolic_(void **Symbolic)	34	34	void umfpack_zl_free_symbolic_(void **Symbolic)
{	35	35	{
umfpack_zl_free_symbolic (Symbolic) ;	36	36	umfpack_zl_free_symbolic (Symbolic) ;
}	37	37	}
	38	38
/* numeric factorization */	39	39	/* numeric factorization */
void umfpack_zl_numeric_ (UF_long Ap [ ], UF_long Ai [ ], double Ax [ ], double Az [ ],	40	40	void umfpack_zl_numeric_ (UF_long Ap [ ], UF_long Ai [ ], double Ax [ ], double Az [ ],
void Symbolic, void Numeric,	41	41	void Symbolic, void Numeric,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	42	42	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	43	43	{
(void) umfpack_zl_numeric (Ap, Ai, Ax, Az, *Symbolic, Numeric, Control, Info);	44	44	(void) umfpack_zl_numeric (Ap, Ai, Ax, Az, *Symbolic, Numeric, Control, Info);
}	45	45	}
	46	46
/* pre-ordering and symbolic factorization */	47	47	/* pre-ordering and symbolic factorization */
void umfpack_zl_symbolic_ (UF_long m, UF_long n, UF_long Ap [ ], UF_long Ai [ ],	48	48	void umfpack_zl_symbolic_ (UF_long m, UF_long n, UF_long Ap [ ], UF_long Ai [ ],
double Ax [ ], double Az [ ], void **Symbolic,	49	49	double Ax [ ], double Az [ ], void **Symbolic,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	50	50	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	51	51	{
(void) umfpack_zl_symbolic (m, n, Ap, Ai, Ax, Az, Symbolic, Control, Info) ;	52	52	(void) umfpack_zl_symbolic (m, n, Ap, Ai, Ax, Az, Symbolic, Control, Info) ;
}	53	53	}
	54	54
/* solve a linear system */	55	55	/* solve a linear system */
	56	56
void umfpack_zl_solve_ (UF_long *sys, UF_long Ap [ ], UF_long Ai [ ], double Ax [ ], double Az [ ],	57	57	void umfpack_zl_solve_ (UF_long *sys, UF_long Ap [ ], UF_long Ai [ ], double Ax [ ], double Az [ ],
double x [ ], double xz [ ], double b [ ], double bz [ ], void **Numeric,	58	58	double x [ ], double xz [ ], double b [ ], double bz [ ], void **Numeric,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	59	59	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	60	60	{
(void) umfpack_zl_solve (*sys, Ap, Ai, Ax, Az, x, xz, b, bz,	61	61	(void) umfpack_zl_solve (*sys, Ap, Ai, Ax, Az, x, xz, b, bz,
*Numeric, Control, Info) ;	62	62	*Numeric, Control, Info) ;
}	63	63	}
	64	64
/* triplet 2 col */	65	65	/* triplet 2 col */
	66	66
void umfpack_zl_triplet_to_col_ (UF_long m, UF_long n, UF_long *nz, UF_long Ti [ ], UF_long Tj [ ],	67	67	void umfpack_zl_triplet_to_col_ (UF_long m, UF_long n, UF_long *nz, UF_long Ti [ ], UF_long Tj [ ],
double Tx [ ], double Tz [ ], UF_long Ap [ ], UF_long Ai [ ],	68	68	double Tx [ ], double Tz [ ], UF_long Ap [ ], UF_long Ai [ ],
double Ax [ ], double Az [ ], UF_long *status)	69	69	double Ax [ ], double Az [ ], UF_long *status)
{	70	70	{
status = umfpack_zl_triplet_to_col (m, n, nz, Ti, Tj, Tx, Tz, Ap, Ai, Ax, Az, (UF_long *) NULL);	71	71	status = umfpack_zl_triplet_to_col (m, n, nz, Ti, Tj, Tx, Tz, Ap, Ai, Ax, Az, (UF_long *) NULL);
}	72	72	}
	73	73
	74	74
		75	/* get determinant */
		76	void umfpack_zl_get_determinant_ ( double Mx, double Mz, double Ex, void Numeric, double Info [UMFPACK_INFO], UF_long status )
		77	{
		78	status = umfpack_zl_get_determinant (Mx,Mz,Ex,Numeric, Info);
		79	}
	75	80
	76	81
/* complex(8) and integer(4) */	77	82	/* complex(8) and integer(4) */
	78	83
/* defaults */	79	84	/* defaults */
	80	85
void umfpack_zi_defaults_ (double Control [UMFPACK_CONTROL])	81	86	void umfpack_zi_defaults_ (double Control [UMFPACK_CONTROL])
{	82	87	{
umfpack_zi_defaults (Control) ;	83	88	umfpack_zi_defaults (Control) ;
}	84	89	}
	85	90
	86	91
/* free the Numeric object */	87	92	/* free the Numeric object */
void umfpack_zi_free_numeric_(void **Numeric)	88	93	void umfpack_zi_free_numeric_(void **Numeric)
{	89	94	{
umfpack_zi_free_numeric (Numeric) ;	90	95	umfpack_zi_free_numeric (Numeric) ;
}	91	96	}
	92	97
/* free the Symbolic object */	93	98	/* free the Symbolic object */
void umfpack_zi_free_symbolic_(void **Symbolic)	94	99	void umfpack_zi_free_symbolic_(void **Symbolic)
{	95	100	{
umfpack_zi_free_symbolic (Symbolic) ;	96	101	umfpack_zi_free_symbolic (Symbolic) ;
}	97	102	}
	98	103
/* numeric factorization */	99	104	/* numeric factorization */
void umfpack_zi_numeric_ (int Ap [ ], int Ai [ ], double Ax [ ], double Az [ ],	100	105	void umfpack_zi_numeric_ (int Ap [ ], int Ai [ ], double Ax [ ], double Az [ ],
void Symbolic, void Numeric,	101	106	void Symbolic, void Numeric,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	102	107	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	103	108	{
(void) umfpack_zi_numeric (Ap, Ai, Ax, Az, *Symbolic, Numeric, Control, Info);	104	109	(void) umfpack_zi_numeric (Ap, Ai, Ax, Az, *Symbolic, Numeric, Control, Info);
}	105	110	}
	106	111
/* pre-ordering and symbolic factorization */	107	112	/* pre-ordering and symbolic factorization */
void umfpack_zi_symbolic_ (int m, int n, int Ap [ ], int Ai [ ],	108	113	void umfpack_zi_symbolic_ (int m, int n, int Ap [ ], int Ai [ ],
double Ax [ ], double Az [ ], void **Symbolic,	109	114	double Ax [ ], double Az [ ], void **Symbolic,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	110	115	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	111	116	{
(void) umfpack_zi_symbolic (m, n, Ap, Ai, Ax, Az, Symbolic, Control, Info) ;	112	117	(void) umfpack_zi_symbolic (m, n, Ap, Ai, Ax, Az, Symbolic, Control, Info) ;
}	113	118	}
	114	119
/* solve a linear system */	115	120	/* solve a linear system */
	116	121
void umfpack_zi_solve_ (int *sys, int Ap [ ], int Ai [ ], double Ax [ ], double Az [ ],	117	122	void umfpack_zi_solve_ (int *sys, int Ap [ ], int Ai [ ], double Ax [ ], double Az [ ],
double x [ ], double xz [ ], double b [ ], double bz [ ], void **Numeric,	118	123	double x [ ], double xz [ ], double b [ ], double bz [ ], void **Numeric,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	119	124	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	120	125	{
(void) umfpack_zi_solve (*sys, Ap, Ai, Ax, Az, x, xz, b, bz,	121	126	(void) umfpack_zi_solve (*sys, Ap, Ai, Ax, Az, x, xz, b, bz,
*Numeric, Control, Info) ;	122	127	*Numeric, Control, Info) ;
}	123	128	}
	124	129
/* triplet 2 col */	125	130	/* triplet 2 col */
	126	131
void umfpack_zi_triplet_to_col_ (int m, int n, int *nz, int Ti [ ], int Tj [ ],	127	132	void umfpack_zi_triplet_to_col_ (int m, int n, int *nz, int Ti [ ], int Tj [ ],
double Tx [ ], double Tz [ ], int Ap [ ], int Ai [ ],	128	133	double Tx [ ], double Tz [ ], int Ap [ ], int Ai [ ],
double Ax [ ], double Az [ ], int *status)	129	134	double Ax [ ], double Az [ ], int *status)
{	130	135	{
status = umfpack_zi_triplet_to_col (m, n, nz, Ti, Tj, Tx, Tz, Ap, Ai, Ax, Az, (int *) NULL);	131	136	status = umfpack_zi_triplet_to_col (m, n, nz, Ti, Tj, Tx, Tz, Ap, Ai, Ax, Az, (int *) NULL);
}	132	137	}
	133	138
		139
		140	/* get determinant */
		141	void umfpack_zi_get_determinant_ ( double Mx, double Mz, double Ex, void Numeric, double Info [UMFPACK_INFO], int status )
		142	{
		143	status = umfpack_zi_get_determinant (Mx,Mz,Ex,Numeric, Info);
		144	}
		145
		146
/* real(8) and integer(8) */	134	147	/* real(8) and integer(8) */
	135	148
/* defaults */	136	149	/* defaults */
	137	150
void umfpack_dl_defaults_ (double Control [UMFPACK_CONTROL])	138	151	void umfpack_dl_defaults_ (double Control [UMFPACK_CONTROL])
{	139	152	{
umfpack_dl_defaults (Control) ;	140	153	umfpack_dl_defaults (Control) ;
}	141	154	}
	142	155
void umfpack_dl_free_numeric_ (void **Numeric)	143	156	void umfpack_dl_free_numeric_ (void **Numeric)
{	144	157	{
umfpack_dl_free_numeric (Numeric) ;	145	158	umfpack_dl_free_numeric (Numeric) ;
}	146	159	}
	147	160
void umfpack_dl_free_symbolic_ (void **Symbolic)	148	161	void umfpack_dl_free_symbolic_ (void **Symbolic)
{	149	162	{
umfpack_dl_free_symbolic (Symbolic) ;	150	163	umfpack_dl_free_symbolic (Symbolic) ;
}	151	164	}
	152	165
void umfpack_dl_numeric_ (UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],	153	166	void umfpack_dl_numeric_ (UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],
void Symbolic, void Numeric,	154	167	void Symbolic, void Numeric,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	155	168	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	156	169	{
(void) umfpack_dl_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);	157	170	(void) umfpack_dl_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);
}	158	171	}
	159	172
void umfpack_dl_symbolic_ (UF_long m, UF_long n, UF_long Ap [ ], UF_long Ai [ ],	160	173	void umfpack_dl_symbolic_ (UF_long m, UF_long n, UF_long Ap [ ], UF_long Ai [ ],
double Ax [ ], void **Symbolic,	161	174	double Ax [ ], void **Symbolic,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	162	175	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	163	176	{
(void) umfpack_dl_symbolic (m, n, Ap, Ai, Ax, Symbolic, Control, Info) ;	164	177	(void) umfpack_dl_symbolic (m, n, Ap, Ai, Ax, Symbolic, Control, Info) ;
}	165	178	}
	166	179
void umfpack_dl_solve_ (UF_long *sys, UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],	167	180	void umfpack_dl_solve_ (UF_long *sys, UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],
double x [ ], double b [ ], void **Numeric,	168	181	double x [ ], double b [ ], void **Numeric,
double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])	169	182	double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
{	170	183	{
(void) umfpack_dl_solve (sys, Ap, Ai, Ax, x, b, Numeric, Control, Info) ;	171	184	(void) umfpack_dl_solve (sys, Ap, Ai, Ax, x, b, Numeric, Control, Info) ;
}	172	185	}
	173	186
void umfpack_dl_triplet_to_col_ (UF_long m, UF_long n, UF_long *nz, UF_long Ti [ ], UF_long Tj [ ],	174	187	void umfpack_dl_triplet_to_col_ (UF_long m, UF_long n, UF_long *nz, UF_long Ti [ ], UF_long Tj [ ],
double T [ ], UF_long Ap [ ], UF_long Ai [ ],	175	188	double T [ ], UF_long Ap [ ], UF_long Ai [ ],
double A [ ], UF_long *status)	176	189	double A [ ], UF_long *status)
{	177	190	{
status = umfpack_dl_triplet_to_col (m, n, nz, Ti, Tj, T, Ap, Ai, A, (UF_long *) NULL);	178	191	status = umfpack_dl_triplet_to_col (m, n, nz, Ti, Tj, T, Ap, Ai, A, (UF_long *) NULL);
}	179	192	}
	180	193
		194	/* get determinant */
		195	void umfpack_dl_get_determinant_ ( double Mx, double Ex, void *Numeric, double Info [UMFPACK_INFO], UF_long status )
		196	{
		197	status = umfpack_dl_get_determinant (Mx,Ex,Numeric, Info);
		198	}
		199
		200
		201
/* real(8) and integer(4) */	181	202	/* real(8) and integer(4) */
	182	203
/* defaults */	183	204	/* defaults */
	184	205
void umfpack_di_defaults_ (double Control [UMFPACK_CONTROL])	185	206	void umfpack_di_defaults_ (double Control [UMFPACK_CONTROL])