File: z_f_main.F90

package info (click to toggle)
superlu 7.0.1%2Bdfsg1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 12,292 kB
  • sloc: ansic: 59,338; makefile: 413; csh: 141; f90: 125; fortran: 77
file content (65 lines) | stat: -rw-r--r-- 1,820 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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
53
54
55
56
57
58
59
60
61
62
63
64
65
!
! Copyright (c) 2003, The Regents of the University of California, through
! Lawrence Berkeley National Laboratory (subject to receipt of any required 
! approvals from U.S. Dept. of Energy) 
! 
! All rights reserved. 
! 
! The source code is distributed under BSD license, see the file License.txt
! at the top-level directory.
!

#include "superlu_config.fh"

      program z_f_main
      integer maxn, maxnz
      parameter ( maxn = 10000, maxnz = 100000 )
#if (XSDK_INDEX_SIZE==64)
      integer*8 rowind(maxnz), colptr(maxn)
#else      
      integer rowind(maxnz), colptr(maxn)
#endif      
      complex*16  values(maxnz), b(maxn)
      integer n, nnz, nrhs, ldb, info, iopt
      integer*8 factors

      call zhbcode1(n, n, nnz, values, rowind, colptr)

      nrhs = 1
      ldb = n
      do i = 1, n
         b(i) = (1,2) + i*(3,4)
      enddo

! First, factorize the matrix. The factors are stored in *factors* handle.
      iopt = 1
      call c_fortran_zgssv( iopt, n, nnz, nrhs, values, rowind, colptr, &
           b, ldb, factors, info )
      
      if (info .eq. 0) then
         write (*,*) 'Factorization succeeded'
      else
         write(*,*) 'INFO from factorization = ', info
      endif
      
! Second, solve the system using the existing factors.
      iopt = 2
      call c_fortran_zgssv( iopt, n, nnz, nrhs, values, rowind, colptr, &
                           b, ldb, factors, info )

      if (info .eq. 0) then
         write (*,*) 'Solve succeeded'
         write (*,*) (b(i), i=1, 10)
      else
         write(*,*) 'INFO from triangular solve = ', info
      endif

! Last, free the storage allocated inside SuperLU
      iopt = 3
      call c_fortran_zgssv( iopt, n, nnz, nrhs, values, rowind, colptr, &
                           b, ldb, factors, info )
!
      stop
      end