mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 04:12:09 +00:00
*** empty log message ***
This commit is contained in:
@@ -441,6 +441,8 @@ contains
|
||||
write (0,'("Error from call to a subroutine ")')
|
||||
case(4012)
|
||||
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
|
||||
case(4013)
|
||||
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
|
||||
case(4110)
|
||||
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
|
||||
case (5001)
|
||||
|
||||
@@ -45,7 +45,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
|
||||
implicit none
|
||||
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(in), target :: desc_a
|
||||
type(psb_dbaseprc_type), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
|
||||
|
||||
@@ -58,7 +58,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
|
||||
Use psb_spmat_type
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
type(psb_dspmat_type), target :: a
|
||||
type(psb_dspmat_type) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dbaseprc_type),intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
@@ -74,10 +74,10 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dbaseprc_type), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(in), target :: desc_a
|
||||
type(psb_dbaseprc_type), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dmlprc_bld
|
||||
end interface
|
||||
|
||||
|
||||
@@ -45,7 +45,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
|
||||
implicit none
|
||||
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(in), target :: desc_a
|
||||
type(psb_zbaseprc_type), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
|
||||
|
||||
@@ -74,10 +74,10 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
|
||||
type(psb_zspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_zbaseprc_type), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(in), target :: desc_a
|
||||
type(psb_zbaseprc_type), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_zmlprc_bld
|
||||
end interface
|
||||
|
||||
|
||||
+74
-22
@@ -130,12 +130,13 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
|
||||
call psb_inner_ins(nz,ia,ja,val,nza,a%ia1,a%ia2,a%aspk,&
|
||||
& imin,imax,jmin,jmax,info,gtl,ng)
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
& imin,imax,jmin,jmax,info,gtl,ng)
|
||||
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
if (debug) then
|
||||
@@ -158,13 +159,12 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
nza = a%ia2(ip1+psb_nnz_)
|
||||
|
||||
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,&
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,size(a%aspk),&
|
||||
& imin,imax,jmin,jmax,nzl,info,gtl,ng)
|
||||
|
||||
if (info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_inner_upd'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
if (debug) then
|
||||
@@ -189,11 +189,23 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
call psb_nullify_sp(tmp)
|
||||
tmp%fida='COO'
|
||||
call psb_csdp(a,tmp,info)
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_csdp'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
endif
|
||||
call psb_sp_setifld(psb_spmat_bld_,psb_state_,tmp,info)
|
||||
if (debug) then
|
||||
write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst
|
||||
endif
|
||||
call psb_sp_transfer(tmp,a,info)
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_sp_transfer'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
endif
|
||||
call psb_spinfo(psb_nztotreq_,a,nza,info)
|
||||
call psb_spinfo(psb_nzsizereq_,a,isza,info)
|
||||
if(info /= izero) then
|
||||
@@ -204,7 +216,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
|
||||
if (debug) write(0,*)&
|
||||
& 'COINS: Reinserting',a%fida,nza,isza
|
||||
& 'COINS: Reinserting',a%fida,nza,isza,irst,nz
|
||||
if ((nza+nz)>isza) then
|
||||
call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info)
|
||||
if(info /= izero) then
|
||||
@@ -216,7 +228,14 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
if (irst <= nz) then
|
||||
call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),&
|
||||
& nza,a%ia1,a%ia2,a%aspk,imin,imax,jmin,jmax,info,gtl,ng)
|
||||
& nza,a%ia1,a%ia2,a%aspk,&
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
&imin,imax,jmin,jmax,info,gtl,ng)
|
||||
if (info /= izero) then
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
endif
|
||||
|
||||
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
|
||||
call psb_sp_setifld(nza,psb_nnz_,a,info)
|
||||
end if
|
||||
@@ -283,12 +302,13 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
|
||||
call psb_inner_ins(nz,ia,ja,val,nza,a%ia1,a%ia2,a%aspk,&
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
|
||||
goto 9999
|
||||
endif
|
||||
if (debug) then
|
||||
@@ -298,6 +318,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
end if
|
||||
if ((nza - psb_sp_getifld(psb_nnz_,a,info)) /= nz) then
|
||||
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
|
||||
!!$ write(0,*) 'Settind del_bnd_ 2: ',nza
|
||||
endif
|
||||
call psb_sp_setifld(nza,psb_nnz_,a,info)
|
||||
|
||||
@@ -311,15 +332,14 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
nza = a%ia2(ip1+psb_nnz_)
|
||||
|
||||
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,&
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,size(a%aspk),&
|
||||
& imin,imax,jmin,jmax,nzl,info)
|
||||
|
||||
if (info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_inner_upd'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (debug) then
|
||||
if ((nza - a%ia2(ip1+psb_nnz_)) /= nz) then
|
||||
write(0,*) 'PSB_COINS: update discarded items '
|
||||
@@ -369,7 +389,14 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
if (irst <= nz) then
|
||||
call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),&
|
||||
& nza,a%ia1,a%ia2,a%aspk,imin,imax,jmin,jmax,info)
|
||||
& nza,a%ia1,a%ia2,a%aspk,&
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
if (info /= izero) then
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
endif
|
||||
|
||||
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
|
||||
call psb_sp_setifld(nza,psb_nnz_,a,info)
|
||||
end if
|
||||
@@ -388,7 +415,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
|
||||
case default
|
||||
|
||||
info = 2231
|
||||
info = 2233
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end select
|
||||
@@ -417,11 +444,11 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_inner_upd(nz,ia,ja,val,nza,aspk,&
|
||||
subroutine psb_inner_upd(nz,ia,ja,val,nza,aspk,maxsz,&
|
||||
& imin,imax,jmin,jmax,nzl,info,gtl,ng)
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl,maxsz
|
||||
integer, intent(in) :: ia(*),ja(*)
|
||||
integer, intent(inout) :: nza
|
||||
real(kind(1.d0)), intent(in) :: val(*)
|
||||
@@ -435,9 +462,14 @@ contains
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
if (nza >= nzl) then
|
||||
if ((nza > nzl)) then
|
||||
do i=1, nz
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
write(0,*) 'Out of bounds in INNER_UPD ',nza,maxsz
|
||||
info = -71
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end do
|
||||
else
|
||||
@@ -449,15 +481,23 @@ contains
|
||||
ic = gtl(ic)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
info = -72
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
else
|
||||
if (nza >= nzl) then
|
||||
if ((nza >= nzl)) then
|
||||
do i=1, nz
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
info = -73
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end do
|
||||
else
|
||||
@@ -466,6 +506,10 @@ contains
|
||||
ic = ja(i)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
info = -74
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end if
|
||||
end do
|
||||
@@ -473,11 +517,11 @@ contains
|
||||
end if
|
||||
end subroutine psb_inner_upd
|
||||
|
||||
subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,&
|
||||
subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,&
|
||||
& imin,imax,jmin,jmax,info,gtl,ng)
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax,maxsz
|
||||
integer, intent(in) :: ia(*),ja(*)
|
||||
integer, intent(inout) :: nza,ia1(*),ia2(*)
|
||||
real(kind(1.d0)), intent(in) :: val(*)
|
||||
@@ -500,6 +544,10 @@ contains
|
||||
ic = gtl(ic)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza > maxsz) then
|
||||
info = -91
|
||||
return
|
||||
endif
|
||||
ia1(nza) = ir
|
||||
ia2(nza) = ic
|
||||
aspk(nza) = val(i)
|
||||
@@ -513,6 +561,10 @@ contains
|
||||
ic = ja(i)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza > maxsz) then
|
||||
info = -92
|
||||
return
|
||||
endif
|
||||
ia1(nza) = ir
|
||||
ia2(nza) = ic
|
||||
aspk(nza) = val(i)
|
||||
|
||||
@@ -60,7 +60,7 @@ subroutine psb_dspgtrow(irw,a,b,info,append,iren,lrw)
|
||||
integer :: i,j,k,ip,jp,nr,idx, nz,iret,nzb, nza, lrw_, irw_, err_act
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_dspgtrow'
|
||||
name='psb_spgtrow'
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
+74
-22
@@ -130,12 +130,13 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
|
||||
call psb_inner_ins(nz,ia,ja,val,nza,a%ia1,a%ia2,a%aspk,&
|
||||
& imin,imax,jmin,jmax,info,gtl,ng)
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
& imin,imax,jmin,jmax,info,gtl,ng)
|
||||
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
if (debug) then
|
||||
@@ -158,13 +159,12 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
nza = a%ia2(ip1+psb_nnz_)
|
||||
|
||||
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,&
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,size(a%aspk),&
|
||||
& imin,imax,jmin,jmax,nzl,info,gtl,ng)
|
||||
|
||||
if (info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_inner_upd'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
if (debug) then
|
||||
@@ -189,11 +189,23 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
call psb_nullify_sp(tmp)
|
||||
tmp%fida='COO'
|
||||
call psb_csdp(a,tmp,info)
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_csdp'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
endif
|
||||
call psb_sp_setifld(psb_spmat_bld_,psb_state_,tmp,info)
|
||||
if (debug) then
|
||||
write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst
|
||||
endif
|
||||
call psb_sp_transfer(tmp,a,info)
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_sp_transfer'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
endif
|
||||
call psb_spinfo(psb_nztotreq_,a,nza,info)
|
||||
call psb_spinfo(psb_nzsizereq_,a,isza,info)
|
||||
if(info /= izero) then
|
||||
@@ -204,7 +216,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
|
||||
if (debug) write(0,*)&
|
||||
& 'COINS: Reinserting',a%fida,nza,isza
|
||||
& 'COINS: Reinserting',a%fida,nza,isza,irst,nz
|
||||
if ((nza+nz)>isza) then
|
||||
call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info)
|
||||
if(info /= izero) then
|
||||
@@ -216,7 +228,14 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
if (irst <= nz) then
|
||||
call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),&
|
||||
& nza,a%ia1,a%ia2,a%aspk,imin,imax,jmin,jmax,info,gtl,ng)
|
||||
& nza,a%ia1,a%ia2,a%aspk,&
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
&imin,imax,jmin,jmax,info,gtl,ng)
|
||||
if (info /= izero) then
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
endif
|
||||
|
||||
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
|
||||
call psb_sp_setifld(nza,psb_nnz_,a,info)
|
||||
end if
|
||||
@@ -283,12 +302,13 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
|
||||
call psb_inner_ins(nz,ia,ja,val,nza,a%ia1,a%ia2,a%aspk,&
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
|
||||
if(info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
|
||||
goto 9999
|
||||
endif
|
||||
if (debug) then
|
||||
@@ -298,6 +318,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
end if
|
||||
if ((nza - psb_sp_getifld(psb_nnz_,a,info)) /= nz) then
|
||||
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
|
||||
!!$ write(0,*) 'Settind del_bnd_ 2: ',nza
|
||||
endif
|
||||
call psb_sp_setifld(nza,psb_nnz_,a,info)
|
||||
|
||||
@@ -311,15 +332,14 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
nza = a%ia2(ip1+psb_nnz_)
|
||||
|
||||
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,&
|
||||
call psb_inner_upd(nz,ia,ja,val,nza,a%aspk,size(a%aspk),&
|
||||
& imin,imax,jmin,jmax,nzl,info)
|
||||
|
||||
if (info /= izero) then
|
||||
info=4010
|
||||
ch_err='psb_inner_upd'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (debug) then
|
||||
if ((nza - a%ia2(ip1+psb_nnz_)) /= nz) then
|
||||
write(0,*) 'PSB_COINS: update discarded items '
|
||||
@@ -369,7 +389,14 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
endif
|
||||
if (irst <= nz) then
|
||||
call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),&
|
||||
& nza,a%ia1,a%ia2,a%aspk,imin,imax,jmin,jmax,info)
|
||||
& nza,a%ia1,a%ia2,a%aspk,&
|
||||
& min(size(a%ia1),size(a%ia2),size(a%aspk)),&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
if (info /= izero) then
|
||||
ch_err='psb_inner_ins'
|
||||
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
|
||||
endif
|
||||
|
||||
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
|
||||
call psb_sp_setifld(nza,psb_nnz_,a,info)
|
||||
end if
|
||||
@@ -388,7 +415,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
|
||||
case default
|
||||
|
||||
info = 2231
|
||||
info = 2233
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end select
|
||||
@@ -417,11 +444,11 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_inner_upd(nz,ia,ja,val,nza,aspk,&
|
||||
subroutine psb_inner_upd(nz,ia,ja,val,nza,aspk,maxsz,&
|
||||
& imin,imax,jmin,jmax,nzl,info,gtl,ng)
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl,maxsz
|
||||
integer, intent(in) :: ia(*),ja(*)
|
||||
integer, intent(inout) :: nza
|
||||
complex(kind(1.d0)), intent(in) :: val(*)
|
||||
@@ -435,9 +462,14 @@ contains
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
if (nza >= nzl) then
|
||||
if ((nza > nzl)) then
|
||||
do i=1, nz
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
write(0,*) 'Out of bounds in INNER_UPD ',nza,maxsz
|
||||
info = -71
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end do
|
||||
else
|
||||
@@ -449,15 +481,23 @@ contains
|
||||
ic = gtl(ic)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
info = -72
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
else
|
||||
if (nza >= nzl) then
|
||||
if ((nza >= nzl)) then
|
||||
do i=1, nz
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
info = -73
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end do
|
||||
else
|
||||
@@ -466,6 +506,10 @@ contains
|
||||
ic = ja(i)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza>maxsz) then
|
||||
info = -74
|
||||
return
|
||||
endif
|
||||
aspk(nza) = val(i)
|
||||
end if
|
||||
end do
|
||||
@@ -473,11 +517,11 @@ contains
|
||||
end if
|
||||
end subroutine psb_inner_upd
|
||||
|
||||
subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,&
|
||||
subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,&
|
||||
& imin,imax,jmin,jmax,info,gtl,ng)
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax,maxsz
|
||||
integer, intent(in) :: ia(*),ja(*)
|
||||
integer, intent(inout) :: nza,ia1(*),ia2(*)
|
||||
complex(kind(1.d0)), intent(in) :: val(*)
|
||||
@@ -500,6 +544,10 @@ contains
|
||||
ic = gtl(ic)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza > maxsz) then
|
||||
info = -91
|
||||
return
|
||||
endif
|
||||
ia1(nza) = ir
|
||||
ia2(nza) = ic
|
||||
aspk(nza) = val(i)
|
||||
@@ -513,6 +561,10 @@ contains
|
||||
ic = ja(i)
|
||||
if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then
|
||||
nza = nza + 1
|
||||
if (nza > maxsz) then
|
||||
info = -92
|
||||
return
|
||||
endif
|
||||
ia1(nza) = ir
|
||||
ia2(nza) = ic
|
||||
aspk(nza) = val(i)
|
||||
|
||||
@@ -60,7 +60,7 @@ subroutine psb_zspgtrow(irw,a,b,info,append,iren,lrw)
|
||||
integer :: i,j,k,ip,jp,nr,idx, nz,iret,nzb, nza, lrw_, irw_, err_act
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_zspgtrow'
|
||||
name='psb_spgtrow'
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -218,9 +218,9 @@ contains
|
||||
|
||||
do j=a%ia2(i),a%ia2(i+1)-1
|
||||
k = k + 1
|
||||
b%aspk(nzb+k) = a%aspk(j)
|
||||
b%ia1(nzb+k) = i
|
||||
b%ia2(nzb+k) = a%ia1(j)
|
||||
b%aspk(nzb+k) = a%aspk(j)
|
||||
!!$ write(0,*) 'csr_gtrow: in:',a%aspk(j),i,a%ia1(j)
|
||||
end do
|
||||
enddo
|
||||
|
||||
Reference in New Issue
Block a user