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

daniau
1 parent 856145b45a
Showing 3 changed files with 257 additions and 0 deletions Side-by-side Diff
doc/fvn.pdf
fvn_sparse/umfpack_wrapper.c
fvnlib.f90
@@ -130,4 +130,98 @@
 {
     *status = umfpack_zi_triplet_to_col (*m, *n, *nz, Ti, Tj, Tx, Tz, Ap, Ai, Ax, Az, (int *) NULL);
 }
+
+/* real(8) and integer(8) */
+
+/* defaults  */
+
+void umfpack_dl_defaults_ (double Control [UMFPACK_CONTROL])
+{
+    umfpack_dl_defaults (Control) ;
+}
+
+void umfpack_dl_free_numeric_ (void **Numeric)
+{
+    umfpack_dl_free_numeric (Numeric) ;
+}
+
+void umfpack_dl_free_symbolic_ (void **Symbolic)
+{
+    umfpack_dl_free_symbolic (Symbolic) ;
+}
+
+void umfpack_dl_numeric_ (UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],
+    void **Symbolic, void **Numeric,
+    double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
+{
+    (void) umfpack_dl_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);
+}
+
+void umfpack_dl_symbolic_ (UF_long *m, UF_long *n, UF_long Ap [ ], UF_long Ai [ ],
+    double Ax [ ], void **Symbolic,
+    double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
+{
+    (void) umfpack_dl_symbolic (*m, *n, Ap, Ai, Ax, Symbolic, Control, Info) ;
+}
+
+void umfpack_dl_solve_ (UF_long *sys, UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],
+    double x [ ], double b [ ], void **Numeric,
+    double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
+{
+    (void) umfpack_dl_solve (*sys, Ap, Ai, Ax, x, b, *Numeric, Control, Info) ;
+}
+
+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 [ ],
+    double A [ ], UF_long *status)
+{
+    *status = umfpack_dl_triplet_to_col (*m, *n, *nz, Ti, Tj, T, Ap, Ai, A, (UF_long *) NULL);
+}
+
+/* real(8) and integer(4) */
+
+/* defaults  */
+
+void umfpack_di_defaults_ (double Control [UMFPACK_CONTROL])
+{
+    umfpack_di_defaults (Control) ;
+}
+
+void umfpack_di_free_numeric_ (void **Numeric)
+{
+    umfpack_di_free_numeric (Numeric) ;
+}
+
+void umfpack_di_free_symbolic_ (void **Symbolic)
+{
+    umfpack_di_free_symbolic (Symbolic) ;
+}
+
+void umfpack_di_numeric_ (int Ap [ ], int Ai [ ], double Ax [ ],
+    void **Symbolic, void **Numeric,
+    double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
+{
+    (void) umfpack_di_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);
+}
+
+void umfpack_di_symbolic_ (int *m, int *n, int Ap [ ], int Ai [ ],
+    double Ax [ ], void **Symbolic,
+    double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
+{
+    (void) umfpack_di_symbolic (*m, *n, Ap, Ai, Ax, Symbolic, Control, Info) ;
+}
+
+void umfpack_di_solve_ (int *sys, int Ap [ ], int Ai [ ], double Ax [ ],
+    double x [ ], double b [ ], void **Numeric,
+    double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
+{
+    (void) umfpack_di_solve (*sys, Ap, Ai, Ax, x, b, *Numeric, Control, Info) ;
+}
+
+void umfpack_di_triplet_to_col_ (int *m, int *n, int *nz, int Ti [ ], int Tj [ ], 
+    double T [ ], int Ap [ ], int Ai [ ],
+    double A [ ], int *status)
+{
+    *status = umfpack_di_triplet_to_col (*m, *n, *nz, Ti, Tj, T, Ap, Ai, A, (int *) NULL);
+}
@@ -2304,5 +2304,168 @@
 end subroutine
  
  
+
+
+
+
+subroutine fvn_dl_sparse_solve(n,nz,T,Ti,Tj,B,x,status)
+implicit none
+integer(8), intent(in) :: n,nz
+real(8),dimension(nz),intent(in) :: T
+integer(8),dimension(nz),intent(in)  :: Ti,Tj
+real(8),dimension(n),intent(in) :: B
+real(8),dimension(n),intent(out) :: x
+integer(8), intent(out) :: status
+
+integer(8),dimension(:),allocatable :: wTi,wTj
+real(8),dimension(:),allocatable :: A
+integer(8),dimension(:),allocatable :: Ap,Ai
+!integer(8) :: symbolic,numeric
+integer(8) :: symbolic,numeric
+real(8),dimension(90) :: info
+real(8),dimension(20) :: control
+integer(8) :: sys
+
+status=0
+! we use a working copy of Ti and Tj to perform 1-based to 0-based translation
+allocate(wTi(nz),wTj(nz))
+wTi=Ti-1
+wTj=Tj-1
+allocate(A(nz))
+allocate(Ap(n+1),Ai(nz))
+
+! 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)
+! if status is not zero a problem has occured
+if (status /= 0) then
+    write(*,*) "Problem during umfpack_dl_triplet_to_col"
+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
+    write(*,*) "Problem during symbolic analysis"
+    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
+    write(*,*) "Problem during numerical factorization"
+    status=info(1)
+endif
+
+! free the C symbolic pointer
+call umfpack_dl_free_symbolic (symbolic)
+
+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
+    write(*,*) "Problem during solving"
+    status=info(1)
+endif
+
+! free the C numeric pointer
+call umfpack_dl_free_numeric (numeric)
+
+deallocate(A)
+deallocate(wTi,wTj)
+end subroutine
+
+
+
+
+
+
+subroutine fvn_di_sparse_solve(n,nz,T,Ti,Tj,B,x,status)
+implicit none
+integer(4), intent(in) :: n,nz
+real(8),dimension(nz),intent(in) :: T
+integer(4),dimension(nz),intent(in)  :: Ti,Tj
+real(8),dimension(n),intent(in) :: B
+real(8),dimension(n),intent(out) :: x
+integer(4), intent(out) :: status
+
+integer(4),dimension(:),allocatable :: wTi,wTj
+real(8),dimension(:),allocatable :: A
+integer(4),dimension(:),allocatable :: Ap,Ai
+!integer(8) :: symbolic,numeric
+integer(4),dimension(2) :: symbolic,numeric
+! As symbolic and numeric are used to store a C pointer, it is necessary to
+! still use an integer(8) for 64bits machines
+! An other possibility : integer(4),dimension(2) :: symbolic,numeric
+real(8),dimension(90) :: info
+real(8),dimension(20) :: control
+integer(4) :: sys
+
+status=0
+! we use a working copy of Ti and Tj to perform 1-based to 0-based translation
+allocate(wTi(nz),wTj(nz))
+wTi=Ti-1
+wTj=Tj-1
+allocate(A(nz))
+allocate(Ap(n+1),Ai(nz))
+
+! 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)
+! if status is not zero a problem has occured
+if (status /= 0) then
+    write(*,*) "Problem during umfpack_di_triplet_to_col"
+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
+    write(*,*) "Problem during symbolic analysis"
+    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
+    write(*,*) "Problem during numerical factorization"
+    status=info(1)
+endif
+
+! free the C symbolic pointer
+call umfpack_di_free_symbolic (symbolic)
+
+sys=0
+! sys may be used to define type of solving -> see umfpack.h
+
+! Solving
+call umfpack_di_solve (sys, Ap, Ai, A, x, B, numeric, control, info)
+! info(1) should be zero
+if (info(1) /= 0) then
+    write(*,*) "Problem during solving"
+    status=info(1)
+endif
+
+! free the C numeric pointer
+call umfpack_di_free_numeric (numeric)
+
+deallocate(A)
+deallocate(wTi,wTj)
+end subroutine
+
+
+
+
+
+
 end module fvn
...	...	@@ -130,4 +130,98 @@
130	130	{
131	131	status = umfpack_zi_triplet_to_col (m, n, nz, Ti, Tj, Tx, Tz, Ap, Ai, Ax, Az, (int *) NULL);
132	132	}
	133	+
	134	+/* real(8) and integer(8) */
	135	+
	136	+/* defaults */
	137	+
	138	+void umfpack_dl_defaults_ (double Control [UMFPACK_CONTROL])
	139	+{
	140	+ umfpack_dl_defaults (Control) ;
	141	+}
	142	+
	143	+void umfpack_dl_free_numeric_ (void **Numeric)
	144	+{
	145	+ umfpack_dl_free_numeric (Numeric) ;
	146	+}
	147	+
	148	+void umfpack_dl_free_symbolic_ (void **Symbolic)
	149	+{
	150	+ umfpack_dl_free_symbolic (Symbolic) ;
	151	+}
	152	+
	153	+void umfpack_dl_numeric_ (UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],
	154	+ void Symbolic, void Numeric,
	155	+ double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
	156	+{
	157	+ (void) umfpack_dl_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);
	158	+}
	159	+
	160	+void umfpack_dl_symbolic_ (UF_long m, UF_long n, UF_long Ap [ ], UF_long Ai [ ],
	161	+ double Ax [ ], void **Symbolic,
	162	+ double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
	163	+{
	164	+ (void) umfpack_dl_symbolic (m, n, Ap, Ai, Ax, Symbolic, Control, Info) ;
	165	+}
	166	+
	167	+void umfpack_dl_solve_ (UF_long *sys, UF_long Ap [ ], UF_long Ai [ ], double Ax [ ],
	168	+ double x [ ], double b [ ], void **Numeric,
	169	+ double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
	170	+{
	171	+ (void) umfpack_dl_solve (sys, Ap, Ai, Ax, x, b, Numeric, Control, Info) ;
	172	+}
	173	+
	174	+void umfpack_dl_triplet_to_col_ (UF_long m, UF_long n, UF_long *nz, UF_long Ti [ ], UF_long Tj [ ],
	175	+ double T [ ], UF_long Ap [ ], UF_long Ai [ ],
	176	+ double A [ ], UF_long *status)
	177	+{
	178	+ status = umfpack_dl_triplet_to_col (m, n, nz, Ti, Tj, T, Ap, Ai, A, (UF_long *) NULL);
	179	+}
	180	+
	181	+/* real(8) and integer(4) */
	182	+
	183	+/* defaults */
	184	+
	185	+void umfpack_di_defaults_ (double Control [UMFPACK_CONTROL])
	186	+{
	187	+ umfpack_di_defaults (Control) ;
	188	+}
	189	+
	190	+void umfpack_di_free_numeric_ (void **Numeric)
	191	+{
	192	+ umfpack_di_free_numeric (Numeric) ;
	193	+}
	194	+
	195	+void umfpack_di_free_symbolic_ (void **Symbolic)
	196	+{
	197	+ umfpack_di_free_symbolic (Symbolic) ;
	198	+}
	199	+
	200	+void umfpack_di_numeric_ (int Ap [ ], int Ai [ ], double Ax [ ],
	201	+ void Symbolic, void Numeric,
	202	+ double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
	203	+{
	204	+ (void) umfpack_di_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);
	205	+}
	206	+
	207	+void umfpack_di_symbolic_ (int m, int n, int Ap [ ], int Ai [ ],
	208	+ double Ax [ ], void **Symbolic,
	209	+ double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
	210	+{
	211	+ (void) umfpack_di_symbolic (m, n, Ap, Ai, Ax, Symbolic, Control, Info) ;
	212	+}
	213	+
	214	+void umfpack_di_solve_ (int *sys, int Ap [ ], int Ai [ ], double Ax [ ],
	215	+ double x [ ], double b [ ], void **Numeric,
	216	+ double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
	217	+{
	218	+ (void) umfpack_di_solve (sys, Ap, Ai, Ax, x, b, Numeric, Control, Info) ;
	219	+}
	220	+
	221	+void umfpack_di_triplet_to_col_ (int m, int n, int *nz, int Ti [ ], int Tj [ ],
	222	+ double T [ ], int Ap [ ], int Ai [ ],
	223	+ double A [ ], int *status)
	224	+{
	225	+ status = umfpack_di_triplet_to_col (m, n, nz, Ti, Tj, T, Ap, Ai, A, (int *) NULL);
	226	+}
...	...	@@ -2304,5 +2304,168 @@
2304	2304	end subroutine
2305	2305
2306	2306
	2307	+
	2308	+
	2309	+
	2310	+
	2311	+subroutine fvn_dl_sparse_solve(n,nz,T,Ti,Tj,B,x,status)
	2312	+implicit none
	2313	+integer(8), intent(in) :: n,nz
	2314	+real(8),dimension(nz),intent(in) :: T
	2315	+integer(8),dimension(nz),intent(in) :: Ti,Tj
	2316	+real(8),dimension(n),intent(in) :: B
	2317	+real(8),dimension(n),intent(out) :: x
	2318	+integer(8), intent(out) :: status
	2319	+
	2320	+integer(8),dimension(:),allocatable :: wTi,wTj
	2321	+real(8),dimension(:),allocatable :: A
	2322	+integer(8),dimension(:),allocatable :: Ap,Ai
	2323	+!integer(8) :: symbolic,numeric
	2324	+integer(8) :: symbolic,numeric
	2325	+real(8),dimension(90) :: info
	2326	+real(8),dimension(20) :: control
	2327	+integer(8) :: sys
	2328	+
	2329	+status=0
	2330	+! we use a working copy of Ti and Tj to perform 1-based to 0-based translation
	2331	+allocate(wTi(nz),wTj(nz))
	2332	+wTi=Ti-1
	2333	+wTj=Tj-1
	2334	+allocate(A(nz))
	2335	+allocate(Ap(n+1),Ai(nz))
	2336	+
	2337	+! perform the triplet to compressed column form -> Ap,Ai,Ax,Az
	2338	+call umfpack_dl_triplet_to_col(n,n,nz,wTi,wTj,T,Ap,Ai,A,status)
	2339	+! if status is not zero a problem has occured
	2340	+if (status /= 0) then
	2341	+ write(,) "Problem during umfpack_dl_triplet_to_col"
	2342	+endif
	2343	+
	2344	+! Define defaults control values
	2345	+call umfpack_dl_defaults(control)
	2346	+
	2347	+! Symbolic analysis
	2348	+call umfpack_dl_symbolic(n,n,Ap,Ai,A,symbolic, control, info)
	2349	+! info(1) should be zero
	2350	+if (info(1) /= 0) then
	2351	+ write(,) "Problem during symbolic analysis"
	2352	+ status=info(1)
	2353	+endif
	2354	+
	2355	+! Numerical factorization
	2356	+call umfpack_dl_numeric (Ap, Ai, A, symbolic, numeric, control, info)
	2357	+! info(1) should be zero
	2358	+if (info(1) /= 0) then
	2359	+ write(,) "Problem during numerical factorization"
	2360	+ status=info(1)
	2361	+endif
	2362	+
	2363	+! free the C symbolic pointer
	2364	+call umfpack_dl_free_symbolic (symbolic)
	2365	+
	2366	+sys=0
	2367	+! sys may be used to define type of solving -> see umfpack.h
	2368	+
	2369	+! Solving
	2370	+call umfpack_dl_solve (sys, Ap, Ai, A, x, B, numeric, control, info)
	2371	+! info(1) should be zero
	2372	+if (info(1) /= 0) then
	2373	+ write(,) "Problem during solving"
	2374	+ status=info(1)
	2375	+endif
	2376	+
	2377	+! free the C numeric pointer
	2378	+call umfpack_dl_free_numeric (numeric)
	2379	+
	2380	+deallocate(A)
	2381	+deallocate(wTi,wTj)
	2382	+end subroutine
	2383	+
	2384	+
	2385	+
	2386	+
	2387	+
	2388	+
	2389	+subroutine fvn_di_sparse_solve(n,nz,T,Ti,Tj,B,x,status)
	2390	+implicit none
	2391	+integer(4), intent(in) :: n,nz
	2392	+real(8),dimension(nz),intent(in) :: T
	2393	+integer(4),dimension(nz),intent(in) :: Ti,Tj
	2394	+real(8),dimension(n),intent(in) :: B
	2395	+real(8),dimension(n),intent(out) :: x
	2396	+integer(4), intent(out) :: status
	2397	+
	2398	+integer(4),dimension(:),allocatable :: wTi,wTj
	2399	+real(8),dimension(:),allocatable :: A
	2400	+integer(4),dimension(:),allocatable :: Ap,Ai
	2401	+!integer(8) :: symbolic,numeric
	2402	+integer(4),dimension(2) :: symbolic,numeric
	2403	+! As symbolic and numeric are used to store a C pointer, it is necessary to
	2404	+! still use an integer(8) for 64bits machines
	2405	+! An other possibility : integer(4),dimension(2) :: symbolic,numeric
	2406	+real(8),dimension(90) :: info
	2407	+real(8),dimension(20) :: control
	2408	+integer(4) :: sys
	2409	+
	2410	+status=0
	2411	+! we use a working copy of Ti and Tj to perform 1-based to 0-based translation
	2412	+allocate(wTi(nz),wTj(nz))
	2413	+wTi=Ti-1
	2414	+wTj=Tj-1
	2415	+allocate(A(nz))
	2416	+allocate(Ap(n+1),Ai(nz))
	2417	+
	2418	+! perform the triplet to compressed column form -> Ap,Ai,Ax,Az
	2419	+call umfpack_di_triplet_to_col(n,n,nz,wTi,wTj,T,Ap,Ai,A,status)
	2420	+! if status is not zero a problem has occured
	2421	+if (status /= 0) then
	2422	+ write(,) "Problem during umfpack_di_triplet_to_col"
	2423	+endif
	2424	+
	2425	+! Define defaults control values
	2426	+call umfpack_di_defaults(control)
	2427	+
	2428	+! Symbolic analysis
	2429	+call umfpack_di_symbolic(n,n,Ap,Ai,A,symbolic, control, info)
	2430	+! info(1) should be zero
	2431	+if (info(1) /= 0) then
	2432	+ write(,) "Problem during symbolic analysis"
	2433	+ status=info(1)
	2434	+endif
	2435	+
	2436	+! Numerical factorization
	2437	+call umfpack_di_numeric (Ap, Ai, A, symbolic, numeric, control, info)
	2438	+! info(1) should be zero
	2439	+if (info(1) /= 0) then
	2440	+ write(,) "Problem during numerical factorization"
	2441	+ status=info(1)
	2442	+endif
	2443	+
	2444	+! free the C symbolic pointer
	2445	+call umfpack_di_free_symbolic (symbolic)
	2446	+
	2447	+sys=0
	2448	+! sys may be used to define type of solving -> see umfpack.h
	2449	+
	2450	+! Solving
	2451	+call umfpack_di_solve (sys, Ap, Ai, A, x, B, numeric, control, info)
	2452	+! info(1) should be zero
	2453	+if (info(1) /= 0) then
	2454	+ write(,) "Problem during solving"
	2455	+ status=info(1)
	2456	+endif
	2457	+
	2458	+! free the C numeric pointer
	2459	+call umfpack_di_free_numeric (numeric)
	2460	+
	2461	+deallocate(A)
	2462	+deallocate(wTi,wTj)
	2463	+end subroutine
	2464	+
	2465	+
	2466	+
	2467	+
	2468	+
	2469	+
2307	2470	end module fvn