USE iso_c_binding
IMPLICIT NONE
INTEGER ::res
INTEGER,TARGET :: istat = 0, i
INTEGER(KIND=RSB_IDX_KIND) :: incx = 1, incy = 1
REAL(KIND=8),target :: alpha = 3, beta = 1
INTEGER(KIND=RSB_IDX_KIND) :: nnz = 4
INTEGER(KIND=RSB_IDX_KIND) :: nr = 2
INTEGER(KIND=RSB_IDX_KIND) :: nc = 2
INTEGER(KIND=RSB_IDX_KIND) :: nrhs = 1
INTEGER(KIND=RSB_IDX_KIND),TARGET :: IA(4) = (/0, 1, 1,0/)
INTEGER(KIND=RSB_IDX_KIND),TARGET :: JA(4) = (/0, 0, 1,1/)
REAL(KIND=8),target :: va(4) = (/1,1,1,1/)
REAL(KIND=8),target :: x(2) = (/1, 1/)
REAL(KIND=8),target :: cy(2) = (/9, 9/)
REAL(KIND=8),target :: y(2) = (/3, 3/)
TYPE(C_PTR),TARGET :: mtxAp = c_null_ptr
REAL(KIND=8) :: tmax = 2.0
INTEGER :: titmax = 2
INTEGER,TARGET :: ont = 0
TYPE(C_PTR),PARAMETER :: EO = c_null_ptr
TYPE(C_PTR),PARAMETER :: IO = c_null_ptr
INTEGER,TARGET :: errval
res = 0
&,nnz,&
istat =
rsb_tune_spmm(c_loc(mtxap),c_null_ptr,c_null_ptr,titmax,&
& tmax,&
& transt,c_loc(alpha),c_null_ptr,nrhs,order,c_loc(x),nr,&
& c_loc(beta),c_loc(y),nc)
& tmax,&
& transt,c_loc(alpha),mtxap,nrhs,order,c_loc(x),nr,c_loc(beta),&
& c_loc(y),nc)
print *, "Optimal number of threads:", ont
y(:) = (/3, 3/)
istat =
rsb_spmv(transt,c_loc(alpha),mtxap,c_loc(x),incx,&
& c_loc(beta),c_loc(y),incy)
DO i = 1, 2
IF (y(i).NE.cy(i)) print *, "type=d dims=2x2 sym=g diag=g &
&blocks=1x1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is not ok"
IF (y(i).NE.cy(i)) GOTO 9997
END DO
print*,"type=d dims=2x2 sym=g diag=g blocks=1x1 usmv alpha= 3&
& beta= 1 incx=1 incy=1 trans=n is ok"
GOTO 9998
9997 res = -1
9998 CONTINUE
& stop "error calling rsb_lib_exit"
print *, "rsb module fortran test is ok"
USE iso_c_binding
IMPLICIT NONE
INTEGER,TARGET :: errval
INTEGER :: res
INTEGER(KIND=RSB_IDX_KIND) :: incX = 1, incb = 1
REAL(KIND=8),target :: alpha = 3,beta = 1
INTEGER(KIND=RSB_IDX_KIND) :: nnzA = 4, nra = 3, nca = 3
INTEGER(KIND=RSB_IDX_KIND),TARGET :: IA(4) = (/1, 2, 3, 3/)
INTEGER(KIND=RSB_IDX_KIND),TARGET :: JA(4) = (/1, 2, 1, 3/)
REAL(KIND=8),target :: va(4) = (/11.0, 22.0, 13.0, 33.0/)
REAL(KIND=8),target :: x(3) = (/ 0, 0, 0/)
REAL(KIND=8),target :: b(3) = (/-1.0, -2.0, -2.0/)
TYPE(C_PTR),TARGET :: mtxAp = c_null_ptr
TYPE(C_PTR) :: mtxApp = c_null_ptr
REAL(KIND=8),target :: etime = 0.0
TYPE(C_PTR),PARAMETER :: EO = c_null_ptr
TYPE(C_PTR),PARAMETER :: IO = c_null_ptr
& stop "error calling rsb_lib_init"
#if defined(__GNUC__) && (__GNUC__ == 4) && (__GNUC_MINOR__ < 5)
#define RSB_SKIP_BECAUSE_OLD_COMPILER 1
#endif
#ifndef RSB_SKIP_BECAUSE_OLD_COMPILER
& c_loc(errval))
& c_loc(va),c_loc(ia),c_loc(ja),nnza,flags)
mtxapp = c_loc(mtxap)
& stop "error calling rsb_mtx_set_vals"
& stop "error calling rsb_mtx_alloc_from_coo_end"
errval =
rsb_spmv(transt,c_loc(alpha),mtxap,c_loc(x),&
& incx,c_loc(beta),c_loc(b),incb)
& stop "error calling rsb_spmv"
& print*,"Time spent in librsb is:",etime
& stop "error calling rsb_mtx_free"
#else
print*,"You have an old Fortran compiler not supporting C_LOC."
print*,"Skipping a part of the test"
#endif
& stop "error calling rsb_lib_exit"
print *, "rsb module fortran test is ok"
res = errval
USE iso_c_binding
IMPLICIT NONE
INTEGER ::res
INTEGER,TARGET :: istat = 0, i
INTEGER(KIND=RSB_IDX_KIND) :: incx = 1, incy = 1
REAL(KIND=8),target :: alpha = 4, beta = 1
INTEGER(KIND=RSB_IDX_KIND), PARAMETER :: nnz = 3
INTEGER(KIND=RSB_IDX_KIND), PARAMETER :: nr = 2
INTEGER(KIND=RSB_IDX_KIND), PARAMETER :: nc = 2
INTEGER(KIND=RSB_IDX_KIND), PARAMETER :: nrhs = 1
INTEGER(KIND=RSB_IDX_KIND),TARGET :: IP(3) = (/1, 2, 4/)
INTEGER(KIND=RSB_IDX_KIND),TARGET :: JA(3) = (/1, 1, 2/)
REAL(KIND=8),target :: va(3) = (/11,21,22/)
REAL(KIND=8),target :: x(2) = (/1, 2/)
REAL(KIND=8),target :: cy(2) = (/215.0, 264.0/)
REAL(KIND=8),target :: y(2) = (/3, 4/)
TYPE(C_PTR),TARGET :: mtxAp = c_null_ptr
REAL(KIND=8) :: tmax = 2.0
INTEGER :: titmax = 2
INTEGER,TARGET :: ont = 0
TYPE(C_PTR),PARAMETER :: EO = c_null_ptr
TYPE(C_PTR),PARAMETER :: IO = c_null_ptr
INTEGER,TARGET :: errval
& stop "error calling rsb_lib_init"
res = 0
istat =
rsb_tune_spmm(c_loc(mtxap),c_null_ptr,c_null_ptr,titmax,&
& tmax,&
& transt,c_loc(alpha),c_null_ptr,nrhs,order,c_loc(x),nr,&
& c_loc(beta),c_loc(y),nc)
& tmax,&
& transt,c_loc(alpha),mtxap,nrhs,order,c_loc(x),nr,c_loc(beta),&
& c_loc(y),nc)
print *, "Optimal number of threads:", ont
y(:) = (/3, 4/)
istat =
rsb_spmv(transt,c_loc(alpha),mtxap,c_loc(x),incx,&
& c_loc(beta),c_loc(y),incy)
print *, y
DO i = 1, 2
IF (y(i).NE.cy(i)) print *, "type=d dims=2x2 sym=s diag=g &
&blocks=1x1 usmv alpha= 4 beta= 1 incx=1 incy=1 trans=n is not ok"
IF (y(i).NE.cy(i)) GOTO 9997
END DO
print*,"type=d dims=2x2 sym=s diag=g blocks=1x1 usmv alpha= 4&
& beta= 1 incx=1 incy=1 trans=n is ok"
GOTO 9998
& stop "error calling rsb_lib_exit"
print *, "rsb module fortran test is ok"
9997 res = -1
9998 CONTINUE
IMPLICIT NONE
IF (res.LT.0) failed = failed + 1
IF (res.EQ.0) passed = passed + 1
IF (res.LT.0) failed = failed + 1
IF (res.EQ.0) passed = passed + 1
IF (res.LT.0) failed = failed + 1
IF (res.EQ.0) passed = passed + 1
print *, "FAILED:", failed
print *, "PASSED:", passed
IF (failed.GT.0) THEN
stop 1
END IF
END PROGRAM
auto main() -> int
Definition: assemble.cpp:38
subroutine rsb_mod_example1(res)
Definition: fortran_rsb_fi.F90:31
subroutine rsb_mod_example3(res)
Definition: fortran_rsb_fi.F90:197
subroutine rsb_mod_example2(res)
Definition: fortran_rsb_fi.F90:127
ISO C BINDING interface to rsb_file_mtx_save.
Definition: rsb.F90:745
ISO C BINDING interface to rsb_lib_exit.
Definition: rsb.F90:107
ISO C BINDING interface to rsb_lib_get_opt.
Definition: rsb.F90:95
ISO C BINDING interface to rsb_lib_init.
Definition: rsb.F90:49
ISO C BINDING interface to rsb_mtx_alloc_from_coo_begin.
Definition: rsb.F90:118
ISO C BINDING interface to rsb_mtx_alloc_from_coo_const.
Definition: rsb.F90:211
ISO C BINDING interface to rsb_mtx_alloc_from_coo_end.
Definition: rsb.F90:134
ISO C BINDING interface to rsb_mtx_alloc_from_csr_const.
Definition: rsb.F90:145
ISO C BINDING interface to rsb_mtx_free.
Definition: rsb.F90:271
ISO C BINDING interface to rsb_mtx_set_vals.
Definition: rsb.F90:650
ISO C BINDING interface to rsb_perror.
Definition: rsb.F90:37
ISO C BINDING interface to rsb_spmv.
Definition: rsb.F90:339
ISO C BINDING interface to rsb_tune_spmm.
Definition: rsb.F90:682
integer(c_int), parameter rsb_flag_default_matrix_flags
See RSB_FLAG_DEFAULT_MATRIX_FLAGS.
Definition: rsb.F90:1027
integer(c_int), parameter rsb_err_no_error
See RSB_ERR_NO_ERROR.
Definition: rsb.F90:874
integer(c_int), parameter rsb_io_want_librsb_etime
See RSB_IO_WANT_LIBRSB_ETIME.
Definition: rsb.F90:1135
integer(c_int), parameter rsb_flag_noflags
See RSB_FLAG_NOFLAGS.
Definition: rsb.F90:932
integer(c_int), parameter rsb_flag_symmetric
See RSB_FLAG_SYMMETRIC.
Definition: rsb.F90:992
integer(c_int), parameter rsb_flag_want_column_major_order
See RSB_FLAG_WANT_COLUMN_MAJOR_ORDER.
Definition: rsb.F90:947
integer(c_int), parameter rsb_transposition_n
Definition: rsb.F90:1067
integer(c_int), parameter rsb_flag_fortran_indices_interface
See RSB_FLAG_FORTRAN_INDICES_INTERFACE.
Definition: rsb.F90:935
integer(c_signed_char), parameter rsb_numerical_type_double
Definition: rsb.F90:1075