File: ftest_sunmatrix_sparse.f90

package info (click to toggle)
sundials 4.1.0%2Bdfsg-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 14,244 kB
  • sloc: ansic: 154,216; f90: 5,573; fortran: 5,166; cpp: 4,321; python: 645; makefile: 54; sh: 49
file content (127 lines) | stat: -rw-r--r-- 3,776 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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
! -----------------------------------------------------------------
! Programmer(s): Cody J. Balos @ LLNL
! -----------------------------------------------------------------
! SUNDIALS Copyright Start
! Copyright (c) 2002-2019, Lawrence Livermore National Security
! and Southern Methodist University.
! All rights reserved.
!
! See the top-level LICENSE and NOTICE files for details.
!
! SPDX-License-Identifier: BSD-3-Clause
! SUNDIALS Copyright End
! -----------------------------------------------------------------
! This file tests the Fortran 2003 interface to the SUNDIALS 
! sparse SUNMatrix implementation.
! -----------------------------------------------------------------


program main

  !======== Inclusions ==========
  use, intrinsic :: iso_c_binding
  use fsunmatrix_sparse_mod
  use fsunmatrix_dense_mod
  use fsunmatrix_band_mod
  use fnvector_serial_mod

  !======== Declarations ========
  implicit none

  ! constants
  real(c_double) :: ZERO = 0.d0
  real(c_double) :: ONE  = 1.d0

  ! local variables
  integer(c_int)  :: fails = 0    ! number of test fails
  integer(c_int)  :: typ          ! type of Sparse matrix
  integer(c_long) :: N            ! dimensions of SUNMatrix
  integer(c_long) :: uband, lband ! bandwidth of band SUNMatrix
  type(c_ptr)     :: A, B         ! Sparse SUNMatrix
  type(c_ptr)     :: D, E         ! Dense and Banded SUNMatrix
  type(c_ptr)     :: x, y         ! NVectors
  type(c_ptr)     :: matdata      ! Matrix data pointer
  integer(c_long) :: lenrw, leniw ! matrix real and int work space size
  integer(c_long) :: val

  N = 100
  uband = 0
  lband = 0

  x = FN_VNew_Serial(N)
  y = FN_VNew_Serial(N)
  
  D = FSUNDenseMatrix(N, N)
  E = FSUNBandMatrix(N, uband, lband, uband)

  !======= Introduction =========
  print *,'Sparse matrix Fortran 2003 interface test'

  !===== Calls to interface =====
  
  ! constructors
  A = FSUNSparseMatrix(N, N, N, CSC_MAT)
  if (.not. c_associated(A)) then
    print *,'>>> FAILED - ERROR in FSUNSparseMatrix; halting'
    stop 1
  end if
  call FSUNMatDestroy_Sparse(A)
  
  A = FSUNSparseFromDenseMatrix(D, ZERO, CSR_MAT)
  if (.not. c_associated(A)) then
    print *,'>>> FAILED - ERROR in FSUNSparseFromDenseMatrix; halting'
    stop 1
  end if
  call FSUNMatDestroy_Sparse(A)
  
  A = FSUNSparseFromBandMatrix(E, ZERO, CSC_MAT)
  if (.not. c_associated(A)) then
    print *,'>>> FAILED - ERROR in FSUNSparseFromBandMatrix; halting'
    stop 1
  end if
  
  ! misc. matrix functions
  val = FSUNSparseMatrix_Rows(A)
  val = FSUNSparseMatrix_Columns(A)
  val = FSUNSparseMatrix_NNZ(A)
  val = FSUNSparseMatrix_NP(A)
  typ = FSUNSparseMatrix_SparseType(A)
  matdata = FSUNSparseMatrix_Data(A)
  matdata = FSUNSparseMatrix_IndexValues(A)
  matdata = FSUNSparseMatrix_IndexPointers(A)
  fails = fails + FSUNSparseMatrix_Realloc(A)
  fails = fails + FSUNSparseMatrix_Reallocate(A, N)
  
  ! matrix operations 
  B = FSUNMatClone_Sparse(A)
  if (.not. c_associated(B)) then
    print *,'>>> FAILED - ERROR in FSUNMatClone_Sparse; halting'
    stop 1
  end if
  val = FSUNMatGetID_Sparse(A)
  fails = fails + FSUNMatZero_Sparse(A)
  fails = fails + FSUNMatCopy_Sparse(A,B)
  fails = fails + FSUNMatScaleAdd_Sparse(ONE, A, B)
  fails = fails + FSUNMatScaleAddI_Sparse(ONE, A)
  fails = fails + FSUNMatMatvec_Sparse(A, x, y)
  fails = fails + FSUNMatSpace_Sparse(A, lenrw, leniw)

  ! destructor
  call FSUNMatDestroy_Sparse(A)

  !======= Cleanup ===========
  call FSUNMatDestroy_Sparse(B)
  call FSUNMatDestroy_Dense(D)
  call FSUNMatDestroy_Band(E)
  call FN_VDestroy_Serial(x)
  call FN_VDestroy_Serial(y)

  if (fails == 0) then
    print *,'    SUCCESS - all tests passed'
  else
    print *,'    FAILURE - ', fails, ' tests failed'
    stop 1
  end if

end program main