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
|
dnl
dnl
include(`rsb_fortran_macros.m4')dnl
dnl
dnl @author: Michele Martone
dnl
dnl FIXME: this code is OBSOLETE and marked for deletion.
dnl
!
dnl ! author: Michele Martone
!
! This is a Sparse BLAS interface.
! It has been generated by a M4 script.
!
! supported types : foreach(`mtype',RSB_M4_MATRIX_TYPES,` RSB_M4_C2F_TYPE(mtype)')
! supported operations : foreach(`pmop',RSB_M4_RSBLAS_INTERFACE_OPS,` RSB_M4_RSBLAS_INTERFACE_IDENTIFIER(pmop)')
!
!
dnl module blas_sparse
module rsb_mod
implicit none
public
foreach(`pmop',RSB_M4_RSBLAS_INTERFACE_OPS,`
interface RSB_M4_RSBLAS_INTERFACE_IDENTIFIER(pmop)
! RSB_M4_RSBLAS_SUBROUTINE_HELP_COMMENT(pmop,`*')
module procedure RSB_M4_INTERFACE_LIST(RSB_M4_COMMA_LIST((RSB_M4_CHOPTRAILINGSPACES(foreach(`mtype',RSB_M4_MATRIX_TYPES,`RSB_M4_RSBLAS_SUBROUTINE_IDENTIFIER(pmop,mtype) ')))))dnl
end interface
')
integer, parameter :: rsb_const_success=0
integer, parameter :: rsb_const_failure=-1 ! value returned by this interface on failure
integer, parameter :: rsb_const_not_available=-9999 ! value returned by this interface when deactivated
contains
subroutine RSB_M4_RSBLAS_INTERFACE_RADIX`_'init(info)
implicit none
integer::info
info = rsb_const_success
#ifdef RSB_HAVE_RSB_KERNELS
call RSB_M4_RSBLAS2VBR_SUBROUTINE_RADIX`'init(info)
if(info.ne.rsb_const_success)info=psb_rsb_const_failure
#else /* RSB_HAVE_RSB_KERNELS */
info = rsb_const_not_available
#endif /* RSB_HAVE_RSB_KERNELS */
end subroutine
subroutine RSB_M4_RSBLAS_INTERFACE_RADIX`_'exit(info)
implicit none
integer::info
info = rsb_const_success
#ifdef RSB_HAVE_RSB_KERNELS
call RSB_M4_RSBLAS2VBR_SUBROUTINE_RADIX`'exit(info)
if(info.ne.rsb_const_success)info=psb_rsb_const_failure
#else /* RSB_HAVE_RSB_KERNELS */
info = rsb_const_not_available
#endif /* RSB_HAVE_RSB_KERNELS */
end subroutine
foreach(`pmop',RSB_M4_RSBLAS_INTERFACE_OPS,`
foreach(`mtype',RSB_M4_MATRIX_TYPES,`
subroutine RSB_M4_RSBLAS_SUBROUTINE_IDENTIFIER(pmop,mtype)`'RSB_M4_RSBLAS_SUBROUTINE_ARGS(pmop,mtype)
! RSB_M4_RSBLAS_SUBROUTINE_HELP_COMMENT(pmop,mtype)
implicit none
RSB_M4_RSBLAS_SUBROUTINE_INFO_DECLARATION(info)dnl
RSB_M4_RSBLAS_SUBROUTINE_ARGS_DECLARATION(pmop,mtype)dnl
#ifdef RSB_HAVE_RSB_KERNELS
info = rsb_const_success
ifelse(pmop,`get_rows_sparse',`dnl
if(append)appendi=1
if(has_iren)has_ireni=1
')`'dnl
ifelse(pmop,`ussm',`dnl
dnl itrans=78 ! FIXME: temporary
')dnl
ifelse(pmop,`usmm',`dnl
dnl itrans=78 ! FIXME: temporary
')dnl
ifelse(pmop,`usmv',`dnl
dnl itrans=78 ! FIXME: temporary
')dnl
ifelse(pmop,`infinity_norm',`dnl
dnl itrans=78 ! FIXME: temporary
')dnl
call RSB_M4_RSBLAS2VBR_SUBROUTINE_IDENTIFIER(pmop,mtype)RSB_M4_ARGS_TO_ACTUAL_ARGS_FOR_RSB_INTERFACE((RSB_M4_RSBLAS_SUBROUTINE_ARGS(pmop,mtype)))
ifelse(pmop,`destroy_sparse_matrix',`dnl
')`'dnl
ifelse(pmop,`allocate_sparse_matrix',`dnl
')`'dnl
ifelse(pmop,`get_matrix_nnz',`dnl
')`'dnl
ifelse(pmop,`infinity_norm',`dnl
real_in=in ! FIXME : this is a conversion
')dnl
if(info.ne.rsb_const_success)info = rsb_const_failure
#else /* RSB_HAVE_RSB_KERNELS */
info = rsb_const_not_available
#endif /* RSB_HAVE_RSB_KERNELS */
end subroutine
')
')
dnl end module blas_sparse
end module rsb_mod
dnl
dnl
|
