*** empty log message ***

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

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

Loading…
Cancel
Save