Blame view

fvn_test/test_sparse_zl.f90 1.9 KB
2b83390c6   wdaniau   1) added fvn_spar...
1
2
3
4
5
6
7
  program test_sparse
  ! test sparse routine zl, complex(8) and integer(8)
  use fvn
  implicit none
  integer(kind=dp_kind), parameter :: nz=12
  integer(kind=dp_kind), parameter :: n=5
  complex(kind=dp_kind),dimension(nz) :: A
4bd212285   wdaniau   Changed sparse ro...
8
  real(kind=dp_kind),dimension(nz) :: Ax,Az
2b83390c6   wdaniau   1) added fvn_spar...
9
10
11
  complex(kind=dp_kind),dimension(n,n) :: As
  integer(kind=dp_kind),dimension(nz) :: Ti,Tj
  complex(kind=dp_kind),dimension(n) :: B,x
4bd212285   wdaniau   Changed sparse ro...
12
  real(kind=dp_kind),dimension(n) :: Bx,Bz
2b83390c6   wdaniau   1) added fvn_spar...
13
  integer(kind=dp_kind) :: status,i
c64a05f8a   wdaniau   Sparse Determinan...
14
  real(kind=dp_kind),dimension(3) :: det
2b83390c6   wdaniau   1) added fvn_spar...
15
16
17
18
19
20
21
22
23
  character(len=80) :: fmcmplx
  
  fmcmplx='(5("(",f8.5,",",f8.5,")  "))'
  
  ! Description of the matrix in triplet form
  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.) /)
  B = (/ (8.,3.), (45.,1.), (-3.,-2.), (3.,0.), (19.,2.) /)
  Ti = (/ 1,2,1,3,5,2,3,4,5,3,2,5 /)
  Tj = (/ 1,1,2,2,2,3,3,3,3,4,5,5 /)
4bd212285   wdaniau   Changed sparse ro...
24
25
26
27
  Ax=real(A)
  Az=aimag(A)
  Bx=real(B)
  Bz=aimag(B)
2b83390c6   wdaniau   1) added fvn_spar...
28
29
30
31
32
  ! Reconstruction of the matrix in standard form
  As=0.
  do i=1,nz
      As(Ti(i),Tj(i))=A(i)
  end do
4bd212285   wdaniau   Changed sparse ro...
33
34
35
  ! sparse routines must be fed up with 0-based indices
  Ti=Ti-1
  Tj=Tj-1
2b83390c6   wdaniau   1) added fvn_spar...
36
37
38
39
40
41
42
43
44
45
46
  write(*,*) "Matrix in standard representation :"
  do i=1,5
      write(*,fmcmplx) As(i,:)
  end do
  write(*,*)
  write(*,*) "Standard determinant : ",fvn_det(5,As)
  write(*,*)
  write(*,*) "Right hand side :"
  write(*,fmcmplx) B
  ! can use either specific interface, fvn_zl_sparse_det
  ! either generic one fvn_sparse_det
4bd212285   wdaniau   Changed sparse ro...
47
  call fvn_zl_sparse_det(n,nz,Ax,Az,Ti,Tj,det,status)
2b83390c6   wdaniau   1) added fvn_spar...
48
  write(*,*)
c64a05f8a   wdaniau   Sparse Determinan...
49
  write(*,*) "Sparse Det = ",cmplx(det(1),det(2),kind=dp_kind)*10**det(3)
2b83390c6   wdaniau   1) added fvn_spar...
50
51
52
  ! can use either specific interface fvn_zl_sparse_solve
  ! either generic one fvn_sparse_solve
  ! parameter det is optional
4bd212285   wdaniau   Changed sparse ro...
53
  call fvn_zl_sparse_solve(n,nz,Ax,Az,Ti,Tj,Bx,Bz,x,status,det)
2b83390c6   wdaniau   1) added fvn_spar...
54
  write(*,*)
c64a05f8a   wdaniau   Sparse Determinan...
55
  write(*,*) "Sparse Det as solve option= ",cmplx(det(1),det(2),kind=dp_kind)*10**det(3)
2b83390c6   wdaniau   1) added fvn_spar...
56
57
58
59
60
61
62
  write(*,*)
  write(*,*) "Solution :"
  write(*,fmcmplx) x
  write(*,*)
  write(*,*) "Product matrix Solution :"
  write(*,fmcmplx) matmul(As,x)
  end program