*** empty log message ***

psblas-3.2.0
Salvatore Filippone 12 years ago
parent 4b4d1f06b6
commit 0a6670b20b

@ -69,6 +69,12 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
info = psb_success_
name = 'psb_cdins'
call psb_erractionsave(err_act)
if (.not.desc_a%is_bld()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
ictxt = desc_a%get_context()
dectype = desc_a%get_dectype()
@ -79,12 +85,6 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
call psb_info(ictxt, me, np)
if (.not.desc_a%is_bld()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
if (nz < 0) then
info = 1111
call psb_errpush(info,name)
@ -119,23 +119,25 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
end if
if (present(ila).and.present(jla)) then
call psi_idx_cnv(nz,ia,ila,desc_a,info,owned=.true.)
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == psb_success_) &
& call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0))
& call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
else
if (present(ila).or.present(jla)) then
write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla)
endif
allocate(ila_(nz),stat=info)
allocate(ila_(nz),jla_(nz),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call psi_idx_cnv(nz,ia,ila_,desc_a,info,owned=.true.)
if (info == psb_success_) &
& call psb_cdins(nz,ja,desc_a,info,mask=(ila_(1:nz)>0))
deallocate(ila_)
call desc_a%indxmap%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.)
if (info == psb_success_) then
jla_(1:nz) = ja(1:nz)
call desc_a%indxmap%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0))
end if
deallocate(ila_,jla_,stat=info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
@ -190,14 +192,19 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200
integer(psb_ipk_), allocatable :: ila_(:), jla_(:)
logical, allocatable, target :: mask__(:)
logical, pointer :: mask_(:)
character(len=20) :: name
info = psb_success_
name = 'psb_cdins'
call psb_erractionsave(err_act)
if (.not.desc%is_bld()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
ictxt = desc%get_context()
dectype = desc%get_dectype()
mglob = desc%get_global_rows()
@ -207,12 +214,6 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
call psb_info(ictxt, me, np)
if (.not.desc%is_bld()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
if (nz < 0) then
info = 1111
call psb_errpush(info,name)
@ -246,15 +247,10 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
call psb_errpush(info,name)
goto 9999
end if
mask_ => mask
else
allocate(mask__(nz))
mask_ => mask__
mask_ = .true.
end if
if (present(jla)) then
call psi_idx_ins_cnv(nz,ja,jla,desc,info,mask=mask_,lidx=lidx)
call desc%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx)
else
allocate(jla_(nz),stat=info)
if (info /= psb_success_) then
@ -262,7 +258,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
call psb_errpush(info,name)
goto 9999
end if
call psi_idx_ins_cnv(nz,ja,jla_,desc,info,mask=mask_,lidx=lidx)
call desc%indxmap%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx)
deallocate(jla_)
end if

Loading…
Cancel
Save