Homec4science
Diffusion SPClibs (feature/fft-split) Browse

spclibs/examples/tsparse1.f90
03540012fedefeature/fft-split

Last Change
Raw File

tsparse1.f90
View Options

!>
!> @file tsparse1.f90
!>
!> @brief
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> spclibs is free software: you can redistribute it and/or modify it under
!> the terms of the GNU Lesser General Public License as published by the Free
!> Software Foundation, either version 3 of the License, or (at your option)
!> any later version.
!>
!> spclibs is distributed in the hope that it will be useful, but WITHOUT ANY
!> WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
!> FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
!>
!> You should have received a copy of the GNU Lesser General Public License
!> along with this program. If not, see <https://www.gnu.org/licenses/>.
!>
!> @authors
!> (in alphabetical order)
!> @author Trach-Minh Tran <trach-minh.tran@epfl.ch>
!>
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! MAIN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
PROGRAM main
USE sparse
IMPLICIT none
!
TYPE(zspmat) :: amat
TYPE(zsprow) :: arow
!
LOGICAL :: found
INTEGER :: n=10
INTEGER :: jcol, nnz, i
DOUBLE PRECISION :: valr, vali
DOUBLE COMPLEX :: val, zero=(0.,0.)
DOUBLE COMPLEX, ALLOCATABLE :: arr(:), farr(:)
INTEGER, ALLOCATABLE :: col(:), newcol(:)
!
! Initialize the sparse matrix amat
!
CALL init(n, amat)
!
! Use UPDT_SP to update a sparse row
!
WRITE(*,*) 'Enter a list of positive indices, terminate with a zero'
DO
READ(*,*) jcol
IF(jcol .LE. 0) EXIT
CALL RANDOM_NUMBER(valr)
vali = jcol
val = CMPLX(valr, vali)
CALL updtmat(arow, jcol, val)
END DO
!
! Convert a sparse row to a sequential row
!
nnz = arow%nnz
WRITE(*,'(a,i5)') 'nnz =', nnz
!
ALLOCATE(arr(nnz), col(nnz), newcol(nnz))
CALL getrow(arow, arr, col)
WRITE(*, '(a/(10i8))') 'col', col
WRITE(*, '(a/(10f8.4))') 'arr', arr
!
ALLOCATE(farr(MAXVAL(col)))
CALL getrow(arow, farr)
WRITE(*, '(/a/(10f8.4))') 'farr', farr
!
! Clear element by element of row
!
DO i=1,nnz
CALL putele(arow, col(i), zero)
CALL getrow(arow, arr, newcol)
WRITE(*, '(/a,i6/(10i8))') 'col', arow%nnz, newcol(1:arow%nnz)
END DO
!
! Re-create row using PUTROW and full row
!
CALL putrow(arow, farr)
CALL getrow(arow, arr, col)
WRITE(*,'(/a,i5)') 'nnz =', arow%nnz
WRITE(*, '(a/(10i8))') 'col', col
WRITE(*, '(a/(10f8.4))') 'arr', arr
!
! Clear row using DESTROY
!
CALL destroy(arow)
CALL getrow(arow, arr, newcol)
nnz = arow%nnz
WRITE(*, '(/a,i6/(10i8))') 'col', nnz, newcol(1:nnz)
!
! Re-create row using PUTROW and sparse row
!
CALL putrow(arow, arr, col)
CALL getrow(arow, arr, newcol, nnz)
WRITE(*, '(/a,i6/(10i8))') 'col', nnz, newcol(1:nnz)
WRITE(*, '(a/(10f8.4))') 'arr', arr
!
! Test GETELE
!
i=111;val=0
CALL getele(arow, i, val, found)
WRITE(*,'(/i8,2f8.4,l3)') i, val, found
DO i=1,nnz
CALL getele(arow, col(i), val, found)
WRITE(*,'(i8,2f8.4,l3)') col(i), val, found
END DO
!
! Test destroy_spmat
!
CALL destroy(amat)
END PROGRAM main
c4science · Help