Fitting-L-matrix/src/ptr_structure.f

72 lines
1.9 KiB
Fortran

module ptr_structure
use dim_parameter,only: pst,numdatpt,ndiab,qn
implicit none
public
type, public :: value_loc_ptr
!number of non-zero-elements
integer :: nnz=0
!row position of non-zero values
integer, allocatable :: rowPtr(:)
!column position of non-zero values
integer, allocatable :: colPtr(:)
!holds non-zero values
double precision, allocatable :: values(:,:)
end type value_loc_ptr
contains
subroutine init_ptr(ptr,occupation)
type(value_loc_ptr) :: ptr
logical, intent(in) :: occupation(ndiab,ndiab)
integer :: i,j,k
integer :: m,n,nnz
! Get occupation size for first and second index
m = size(occupation,1)
n = size(occupation,2)
!Count number of non-zero occupation elements
nnz = count(occupation .eqv. .true.)
ptr%nnz = nnz
!Allocate data for pointer arrays and value array
allocate(ptr%rowPtr(nnz),ptr%colPtr(nnz),ptr%values(nnz,numdatpt))
!Get all non-zero elements of occupation
!Write values on values, write positions on rowPtr and colPtr
k=1
!Loop over rows
do i=1,m
!Loop over columns
do j=1,n
!Get non-zero elements and write their values on values & write their positions on rowPtr and colPtr
if(occupation(i,j)) then
ptr%rowPtr(k)=i
ptr%colPtr(k)=j
!Increase counter
k=k+1
endif
enddo
enddo
end subroutine init_ptr
subroutine init_values(ptr,matrix,pt)
type(value_loc_ptr) :: ptr
double precision matrix(ndiab,ndiab)
integer pt
integer l
do l=1,ptr%nnz
ptr%values(l,pt)=matrix(ptr%rowPtr(l),ptr%colPtr(l))
enddo
end subroutine init_values
end module ptr_structure