fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixes for build paths with SuperLU and UMFPACK.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 5ed6b7970b
commit b97283eed5
2 changed files with 38 additions and 24 deletions
Show Stats Download Patch File Download Diff File

31
base/serial/psb_drwextd.f90
Unescape Escape View File

@ -40,6 +40,7 @@
subroutine psb_drwextd(nr,a,info,b,rowscale) subroutine psb_drwextd(nr,a,info,b,rowscale)
use psb_spmat_type use psb_spmat_type
use psb_error_mod use psb_error_mod
use psb_string_mod
implicit none implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -64,13 +65,13 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
end if end if
if (nr > a%m) then if (nr > a%m) then
if (a%fida == 'CSR') then if (toupper(a%fida) == 'CSR') then
call psb_realloc(nr+1,a%ia2,info) call psb_realloc(nr+1,a%ia2,info)
if (present(b)) then if (present(b)) then
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_realloc(size(a%ia1)+nzb,a%ia1,info) call psb_realloc(size(a%ia1)+nzb,a%ia1,info)
call psb_realloc(size(a%aspk)+nzb,a%aspk,info) call psb_realloc(size(a%aspk)+nzb,a%aspk,info)
if (b%fida=='CSR') then if (toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m) do i=1, min(nr-a%m,b%m)
a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i) a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i)
@ -96,31 +97,36 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
end do end do
end if end if
a%m = nr a%m = nr
else if (a%fida == 'COO') then a%k = max(a%k,b%k)
else if (toupper(a%fida) == 'COO') then
if (present(b)) then if (present(b)) then
nza = psb_sp_get_nnzeros(a) nza = psb_sp_get_nnzeros(a)
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_sp_reall(a,nza+nzb,info) call psb_sp_reall(a,nza+nzb,info)
if (b%fida=='COO') then if (toupper(b%fida)=='COO') then
if (rowscale_) then if (rowscale_) then
do j=1,nzb do j=1,nzb
if ((a%m + b%ia1(j)) <= nr) then if ((a%m + b%ia1(j)) <= nr) then
a%ia1(nza+j) = a%m + b%ia1(j) nza = nza + 1
a%ia2(nza+j) = b%ia2(j) a%ia1(nza) = a%m + b%ia1(j)
a%aspk(nza+j) = b%aspk(j) a%ia2(nza) = b%ia2(j)
a%aspk(nza) = b%aspk(j)
end if end if
enddo enddo
else else
do j=1,nzb do j=1,nzb
if ((b%ia1(j)) <= nr) then if ((b%ia1(j)) <= nr) then
a%ia1(nza+j) = b%ia1(j) nza = nza + 1
a%ia2(nza+j) = b%ia2(j) a%ia1(nza) = b%ia1(j)
a%aspk(nza+j) = b%aspk(j) a%ia2(nza) = b%ia2(j)
a%aspk(nza) = b%aspk(j)
endif endif
enddo enddo
endif endif
a%infoa(psb_nnz_) = nza+nzb a%infoa(psb_nnz_) = nza
else if(b%fida=='CSR') then else if(toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m) do i=1, min(nr-a%m,b%m)
do do
jb = b%ia2(i) jb = b%ia2(i)
@ -138,6 +144,7 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
endif endif
endif endif
a%m = nr a%m = nr
a%k = max(a%k,b%k)
else if (a%fida == 'JAD') then else if (a%fida == 'JAD') then
info=135 info=135
ch_err=a%fida(1:3) ch_err=a%fida(1:3)

31
base/serial/psb_zrwextd.f90
Unescape Escape View File

@ -40,6 +40,7 @@
subroutine psb_zrwextd(nr,a,info,b,rowscale) subroutine psb_zrwextd(nr,a,info,b,rowscale)
use psb_spmat_type use psb_spmat_type
use psb_error_mod use psb_error_mod
use psb_string_mod
implicit none implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -64,13 +65,13 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
end if end if
if (nr > a%m) then if (nr > a%m) then
if (a%fida == 'CSR') then if (toupper(a%fida) == 'CSR') then
call psb_realloc(nr+1,a%ia2,info) call psb_realloc(nr+1,a%ia2,info)
if (present(b)) then if (present(b)) then
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_realloc(size(a%ia1)+nzb,a%ia1,info) call psb_realloc(size(a%ia1)+nzb,a%ia1,info)
call psb_realloc(size(a%aspk)+nzb,a%aspk,info) call psb_realloc(size(a%aspk)+nzb,a%aspk,info)
if (b%fida=='CSR') then if (toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m) do i=1, min(nr-a%m,b%m)
a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i) a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i)
@ -96,31 +97,36 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
end do end do
end if end if
a%m = nr a%m = nr
else if (a%fida == 'COO') then a%k = max(a%k,b%k)
else if (toupper(a%fida) == 'COO') then
if (present(b)) then if (present(b)) then
nza = psb_sp_get_nnzeros(a) nza = psb_sp_get_nnzeros(a)
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_sp_reall(a,nza+nzb,info) call psb_sp_reall(a,nza+nzb,info)
if (b%fida=='COO') then if (toupper(b%fida)=='COO') then
if (rowscale_) then if (rowscale_) then
do j=1,nzb do j=1,nzb
if ((a%m + b%ia1(j)) <= nr) then if ((a%m + b%ia1(j)) <= nr) then
a%ia1(nza+j) = a%m + b%ia1(j) nza = nza + 1
a%ia2(nza+j) = b%ia2(j) a%ia1(nza) = a%m + b%ia1(j)
a%aspk(nza+j) = b%aspk(j) a%ia2(nza) = b%ia2(j)
a%aspk(nza) = b%aspk(j)
end if end if
enddo enddo
else else
do j=1,nzb do j=1,nzb
if ((b%ia1(j)) <= nr) then if ((b%ia1(j)) <= nr) then
a%ia1(nza+j) = b%ia1(j) nza = nza + 1
a%ia2(nza+j) = b%ia2(j) a%ia1(nza) = b%ia1(j)
a%aspk(nza+j) = b%aspk(j) a%ia2(nza) = b%ia2(j)
a%aspk(nza) = b%aspk(j)
endif endif
enddo enddo
endif endif
a%infoa(psb_nnz_) = nza+nzb a%infoa(psb_nnz_) = nza
else if(b%fida=='CSR') then else if(toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m) do i=1, min(nr-a%m,b%m)
do do
jb = b%ia2(i) jb = b%ia2(i)
@ -138,6 +144,7 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
endif endif
endif endif
a%m = nr a%m = nr
a%k = max(a%k,b%k)
else if (a%fida == 'JAD') then else if (a%fida == 'JAD') then
info=135 info=135
ch_err=a%fida(1:3) ch_err=a%fida(1:3)

Write Preview
Loading…
Cancel
Save