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

Fixed some internal declarations to be allocatable instead of pointers.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 7148b39c70
commit c364747d82
24 changed files with 154 additions and 66 deletions
Show Stats Download Patch File Download Diff File

5
src/internals/psi_desc_index.f90
Unescape Escape View File

@ -51,8 +51,9 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
integer :: ictxt
integer :: no_comm,err
parameter (no_comm=-1)
! ...local arrays..
integer,pointer :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
! ...local arrays..
integer,allocatable :: brvindx(:),rvsz(:),&
& bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
integer :: ihinsz,ntot,k,err_act, l_di, &
& idxr, idxs, iszs, iszr, nesd, nerv, icomm

6
src/internals/psi_dswapdata.f90
Unescape Escape View File

@ -41,7 +41,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
real(kind(1.d0)) :: y(:,:), beta
real(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
@ -82,7 +82,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = desc_a%matrix_data(psb_mpi_c_)
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_sync = iand(flag,psb_swap_sync_) /= 0
swap_send = iand(flag,psb_swap_send_) /= 0
swap_recv = iand(flag,psb_swap_recv_) /= 0
@ -449,7 +449,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
real(kind(1.d0)) :: y(:), beta
real(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals

6
src/internals/psi_dswaptran.f90
Unescape Escape View File

@ -41,7 +41,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
real(kind(1.d0)) :: y(:,:), beta
real(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
@ -441,8 +441,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
real(kind(1.d0)) :: y(:), beta
real(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
integer, optional :: data
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&

6
src/internals/psi_iswapdata.f90
Unescape Escape View File

@ -41,7 +41,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
integer :: y(:,:), beta
integer, target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
@ -82,7 +82,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = desc_a%matrix_data(psb_mpi_c_)
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_sync = iand(flag,psb_swap_sync_) /= 0
swap_send = iand(flag,psb_swap_send_) /= 0
swap_recv = iand(flag,psb_swap_recv_) /= 0
@ -449,7 +449,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
integer :: y(:), beta
integer, target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals

14
src/internals/psi_iswaptran.f90
Unescape Escape View File

@ -41,7 +41,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
integer :: y(:,:), beta
integer, target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
@ -437,12 +437,12 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
use mpi
implicit none
integer, intent(in) :: flag
integer, intent(out) :: info
integer :: y(:), beta
integer, target :: work(:)
type(psb_desc_type) :: desc_a
integer, optional :: data
integer, intent(in) :: flag
integer, intent(out) :: info
integer :: y(:), beta
integer, target :: work(:)
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&

6
src/internals/psi_zswapdata.f90
Unescape Escape View File

@ -41,7 +41,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
complex(kind(1.d0)) :: y(:,:), beta
complex(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
@ -82,7 +82,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = desc_a%matrix_data(psb_mpi_c_)
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_sync = iand(flag,psb_swap_sync_) /= 0
swap_send = iand(flag,psb_swap_send_) /= 0
swap_recv = iand(flag,psb_swap_recv_) /= 0
@ -449,7 +449,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
complex(kind(1.d0)) :: y(:), beta
complex(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals

8
src/internals/psi_zswaptran.f90
Unescape Escape View File

@ -41,8 +41,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
complex(kind(1.d0)) :: y(:,:), beta
complex(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
integer, optional :: data
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
@ -438,8 +438,8 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer, intent(out) :: info
complex(kind(1.d0)) :: y(:), beta
complex(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
integer, optional :: data
type(psb_desc_type),target :: desc_a
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&

4
src/modules/psb_check_mod.f90
Unescape Escape View File

@ -81,7 +81,7 @@ contains
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
info=0
name='psb_chkvect'
call psb_erractionsave(err_act)
@ -205,7 +205,7 @@ contains
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
info=0
name='psb_chkglobvect'
call psb_erractionsave(err_act)

4
src/modules/psb_serial_mod.f90
Unescape Escape View File

@ -249,7 +249,7 @@ module psb_serial_mod
interface psb_spinfo
subroutine psb_dspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
type(psb_dspmat_type), intent(in),target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires
integer, intent(out) :: info
@ -257,7 +257,7 @@ module psb_serial_mod
end subroutine psb_dspinfo
subroutine psb_zspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(in),target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires
integer, intent(out) :: info

1
src/modules/psb_spmat_type.f90
Unescape Escape View File

@ -1153,6 +1153,5 @@ contains
End Subroutine psb_zsp_free
end module psb_spmat_type

4
src/prec/psb_dasmatbld.f90
Unescape Escape View File

@ -90,6 +90,8 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
If(debug) Write(0,*)'IN DASMATBLD ', upd
ictxt=desc_data%matrix_data(psb_ctxt_)
Call psb_info(ictxt, me, np)
tot_recv=0
nrow_a = desc_data%matrix_data(psb_n_row_)
@ -133,7 +135,6 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
!
!
ictxt=desc_data%matrix_data(psb_ctxt_)
if (novr < 0) then
info=3
@ -173,7 +174,6 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
call psb_get_mpicomm(ictxt,icomm)
Call psb_info(ictxt, me, np)
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = mpi_wtime()

2
src/prec/psb_dbldaggrmat.f90
Unescape Escape View File

@ -633,7 +633,7 @@ contains
call psb_errpush(4010,name,a_err='symbmm 1')
goto 9999
end if
am1%aspk(:) = 0.d0
!!$ am1%aspk(:) = 0.d0
if (test_dump) &
& call psb_csprt(50+me,am1,head='% (I-wDA)Pt symbmm ')

4
src/prec/psb_dilu_bld.f90
Unescape Escape View File

@ -151,10 +151,6 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
goto 9999
endif
! call psb_info(ictxt, me, np)
ictxt=desc_a%matrix_data(psb_ctxt_)
call psb_nullify_sp(blck)
call psb_nullify_sp(atmp)

4
src/prec/psb_dmlprc_bld.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,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
type(psb_dbaseprc_type), intent(inout),target :: p
integer, intent(out) :: info
type(psb_desc_type), pointer :: desc_p
@ -88,7 +88,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
use psb_descriptor_type
use psb_spmat_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dbaseprc_type), intent(inout) :: p
type(psb_dbaseprc_type), intent(inout),target :: p
type(psb_dspmat_type), intent(out),target :: ac
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_p

3
src/prec/psb_dprecbld.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p
type(psb_dbaseprc_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine psb_dmlprc_bld
end interface
@ -128,7 +128,6 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
!
! ALso should define symbolic names for the preconditioners.
!
if (size(p%baseprecv) >= 1) then
call init_baseprc_av(p%baseprecv(1),info)
if (info /= 0) then

1
src/prec/psb_dprecset.f90
Unescape Escape View File

@ -39,6 +39,7 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_string_mod
implicit none
type(psb_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype

2
src/prec/psb_zbldaggrmat.f90
Unescape Escape View File

@ -49,7 +49,7 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,p,desc_p,info)
type(psb_zbaseprc_type), intent(inout) :: p
type(psb_zspmat_type), intent(out), target :: ac
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_p
type(psb_desc_type), intent(inout),target :: desc_p
integer, intent(out) :: info
logical, parameter :: aggr_dump=.false.

1
src/prec/psb_zilu_bld.f90
Unescape Escape View File

@ -58,6 +58,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
use psb_tools_mod
use psb_psblas_mod
use psb_error_mod
use psb_realloc_mod
use psb_penv_mod
implicit none
!

4
src/prec/psb_zmlprc_bld.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,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
type(psb_zbaseprc_type), intent(inout),target :: p
integer, intent(out) :: info
type(psb_desc_type), pointer :: desc_p
@ -88,7 +88,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
use psb_descriptor_type
use psb_spmat_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_zbaseprc_type), intent(inout) :: p
type(psb_zbaseprc_type), intent(inout),target :: p
type(psb_zspmat_type), intent(out),target :: ac
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_p

2
src/prec/psb_zprecbld.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_zbaseprc_type), intent(inout) :: p
type(psb_zbaseprc_type), intent(inout),target :: p
integer, intent(out) :: info
end subroutine psb_zmlprc_bld
end interface

2
src/psblas/psb_dspmm.f90
Unescape Escape View File

@ -194,7 +194,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
allocate(iwork(liwork),stat=info)
if(info /= 0) then
info=4010
ch_err='psb_realloc'

126
src/serial/csr/dcsrmv.f
Unescape Escape View File

@ -314,24 +314,116 @@ C
C
C .......General Not Unit, No Traspose
C
if (beta == zero) then
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j))
enddo
y(i) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = alpha*acc
enddo
endif
IF (BETA.NE.ZERO) THEN
DO 240 I = 1, M
ACC = ZERO
DO 220 J = IA(I), IA(I+1) - 1
ACC = ACC + AS(J)*X(JA(J))
220 CONTINUE
Y(I) = ALPHA*ACC + BETA*Y(I)
240 CONTINUE
ELSE
DO I = 1, M
ACC = ZERO
DO J = IA(I), IA(I+1) - 1
ACC = ACC + AS(J)*X(JA(J))
ENDDO
Y(I) = ALPHA*ACC
ENDDO
ENDIF
else if (beta==one) then
if (alpha==one) then
do i = 1, m
acc = y(i)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = y(i)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j))
enddo
y(i) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = alpha*acc + y(i)
enddo
endif
else if (beta==-one) then
if (alpha==one) then
do i = 1, m
acc = -y(i)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = -y(i)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j))
enddo
y(i) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = alpha*acc - y(i)
enddo
endif
else
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = acc + beta*y(i)
enddo
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j))
enddo
y(i) = acc + beta*y(i)
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j))
enddo
y(i) = alpha*acc + beta*y(i)
enddo
endif
end if
C
ELSE IF (UNI) THEN
C

3
src/tools/psb_cdasb.f90
Unescape Escape View File

@ -112,10 +112,9 @@ subroutine psb_cdasb(desc_a,info)
call psi_cnv_dsc(halo_index,ovrlap_index,desc_a,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_bld_cdesc')
call psb_errpush(4010,name,a_err='psi_cnv_dsc')
goto 9999
end if
! Ok, register into MATRIX_DATA & free temporary work areas
desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_

2
src/tools/psb_cdcpy.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
integer, intent(out) :: info
!locals
integer :: np,me,ictxt, isz, err_act, isz1, isz2
integer :: np,me,ictxt, isz, err_act
logical, parameter :: debug=.false.,debugprt=.false.
character(len=20) :: name, char_err
if (debug) write(0,*) me,'Entered CDCPY'

Write Preview
Loading…
Cancel
Save