program sprs_mat implicit none type:: mat_cell integer:: row integer:: col integer:: val type(mat_cell),pointer:: rt,dn end type type(mat_cell),target:: anchor_a,anchor_b,anchor_c !anchors of ! a, b and c matrices a X b = c type(mat_cell),pointer::moving,moving1 !one imp function of moving ! is to keep track of where the next ! element is added integer:: r1,c1,r2,c2 !row and col values;c1=r2 for multipliability write(*,'("Give row and col values of A matrix")') read (*,*) r1,c1 write(*,'("Give row and col values of B matrix")') read (*,*) r2,c2 write(*,'("Initializing")') call init_opns(anchor_a) call init_opns(anchor_b) call init_opns(anchor_c) write(*,'("Creating guards")') call create_guards(anchor_a,r1,c1) call create_guards(anchor_b,r2,c2) call create_guards(anchor_c,r1,c2) write(*,'("Printing guards of A")') call print_guards(anchor_a) write(*,'("Printing guards of B")') call print_guards(anchor_b) write(*,'("Printing guards of C")') call print_guards(anchor_c) write(*,'("Reading matrix A")') call read_mat(anchor_a,r1,c1) write(*,'("A matrix values row wise are")') call print_mat_row_wise(anchor_a,r1,c1) write(*,'("A matrix values col wise are")') call print_mat_col_wise(anchor_a,r1,c1) write(*,'("Reading matrix B")') call read_mat(anchor_b,r2,c2) write(*,'("B matrix values row wise are")') call print_mat_row_wise(anchor_b,r2,c2) write(*,'("B matrix values col wise are")') call print_mat_col_wise(anchor_b,r2,c2) !call sprs_mult contains subroutine init_opns(anchor) type(mat_cell),target,intent(out)::anchor anchor%row=0 anchor%col=0 anchor%val=0 nullify(anchor%rt,anchor%dn) end subroutine !adding linked list elts subroutine add_elt(direction,r_val,c_val,e_val) integer,intent(in):: direction,r_val,c_val,e_val type(mat_cell),pointer::temp nullify(temp) allocate(temp) temp%row=r_val temp%col=c_val temp%val=e_val nullify(temp%rt,temp%dn) if (direction==1) then !row linking moving%rt=>temp moving=>moving%rt else !col linking moving%dn=>temp moving=>moving%dn end if end subroutine !create guards subroutine create_guards(anchor,nrows,ncols) type(mat_cell),target,intent(inout)::anchor integer,intent(in)::nrows,ncols integer:: i,j moving=>anchor do i=1,nrows call add_elt(2,i,0,0) !2 for col linking end do moving=>anchor do j=1,ncols call add_elt(1,0,j,0) end do end subroutine !printing the guards subroutine print_guards(anchor) type(mat_cell),target,intent(in)::anchor moving=>anchor do write(*,'(3i2," ")',advance='no') moving%row,moving%col,moving%val moving=>moving%rt if (.not.associated(moving)) exit end do write(*,*) moving=>anchor%dn do write(*,'(3i2)') moving%row,moving%col,moving%val moving=>moving%dn if (.not.associated(moving)) exit end do end subroutine subroutine read_mat(anchor,nrows,ncols) type(mat_cell),target,intent(in)::anchor integer,intent(in)::nrows,ncols integer:: i,j integer:: r,c,v,nvals write(*,'("Give the no. of non-zero elements")') read *,nvals print *, "nvals=",nvals do i=1,nvals write(*,'("Give row, col and elt values")') read *, r, c, v !move down to the rth row guard moving=>anchor do j=1,r moving=>moving%dn end do !increment count in the row guard moving%val=moving%val+1 do if (.not. associated(moving%rt)) exit moving=>moving%rt end do call add_elt(1,r,c,v) !1 for row linking moving1=>moving !move right to the cth col guard moving=>anchor do j=1,c moving=>moving%rt end do !increment count in the row guard moving%val=moving%val+1 do if (.not. associated(moving%dn)) exit moving=>moving%dn end do moving%dn=>moving1 end do end subroutine !print matrix subroutine print_mat_row_wise(anchor,nrows,ncols) type(mat_cell),target,intent(in)::anchor integer,intent(in)::nrows,ncols integer::i integer:: zero=0 !'zero' for actual printing of 0 moving=>anchor%dn do moving1=>moving do if (.not.associated(moving%rt)) then do i=moving%col+1,ncols write(*,'(i2)',advance='no') zero end do exit else do i=moving%col+2,moving%rt%col write(*,'(i2)',advance='no') zero end do write(*,'(i2)',advance='no') moving%rt%val end if moving=>moving%rt end do write(*,*) !end of line after the row printing is over moving=>moving1%dn if (.not.associated(moving)) exit end do end subroutine !print matrix subroutine print_mat_col_wise(anchor,nrows,ncols) type(mat_cell),target,intent(in)::anchor integer,intent(in)::nrows,ncols integer::i integer:: zero=0 !'zero' for actual printing of 0 moving=>anchor%rt do moving1=>moving do if (.not.associated(moving%dn)) then do i=moving%row+1,nrows write(*,'(i2)',advance='no') zero end do exit else do i=moving%row+2,moving%dn%row write(*,'(i2)',advance='no') zero end do write(*,'(i2)',advance='no') moving%dn%val end if moving=>moving%dn end do write(*,*) !end of line after the row printing is over moving=>moving1%rt if (.not.associated(moving)) exit end do end subroutine subroutine sprs_mult type(mat_cell),pointer:: pa,pb,pc,pa1,pb1,pc1 integer:: i=0,j=0,c_count=0,sum integer,dimension(r1)::t1 integer,dimension(c2)::t2 pa=>anchor_a pb=>anchor_b do pa=>pa%dn if(.not.asociated(pa)) exit if (pa%val==0) cycle i=pa%row !ith row do pb=>pb%rt if(.not.associated(pb)) exit if(pb%val==0) cycle j=pb%col !jth col sum=0 call fill_row_a(t1) call fill_col_b(t2) sum=dot_prod(t1,t2) moving=>anchor_c add_elt(1,i,j,sum) end do end do end program