diff --git a/src/internals/psi_desc_index.f90 b/src/internals/psi_desc_index.f90 index 8c65b958..890f62e2 100644 --- a/src/internals/psi_desc_index.f90 +++ b/src/internals/psi_desc_index.f90 @@ -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 diff --git a/src/internals/psi_dswapdata.f90 b/src/internals/psi_dswapdata.f90 index 0903d979..7fbcef5b 100644 --- a/src/internals/psi_dswapdata.f90 +++ b/src/internals/psi_dswapdata.f90 @@ -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 diff --git a/src/internals/psi_dswaptran.f90 b/src/internals/psi_dswaptran.f90 index 9e5c1a90..3d36cdbb 100644 --- a/src/internals/psi_dswaptran.f90 +++ b/src/internals/psi_dswaptran.f90 @@ -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,& diff --git a/src/internals/psi_iswapdata.f90 b/src/internals/psi_iswapdata.f90 index 2c745f69..2634f9b1 100644 --- a/src/internals/psi_iswapdata.f90 +++ b/src/internals/psi_iswapdata.f90 @@ -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 diff --git a/src/internals/psi_iswaptran.f90 b/src/internals/psi_iswaptran.f90 index 9a7a11eb..9d5d9b1d 100644 --- a/src/internals/psi_iswaptran.f90 +++ b/src/internals/psi_iswaptran.f90 @@ -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,& diff --git a/src/internals/psi_zswapdata.f90 b/src/internals/psi_zswapdata.f90 index 31633fd8..ba654db2 100644 --- a/src/internals/psi_zswapdata.f90 +++ b/src/internals/psi_zswapdata.f90 @@ -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 diff --git a/src/internals/psi_zswaptran.f90 b/src/internals/psi_zswaptran.f90 index 73d614a2..e7d77d01 100644 --- a/src/internals/psi_zswaptran.f90 +++ b/src/internals/psi_zswaptran.f90 @@ -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,& diff --git a/src/modules/psb_check_mod.f90 b/src/modules/psb_check_mod.f90 index 701ddf56..02d32aaf 100644 --- a/src/modules/psb_check_mod.f90 +++ b/src/modules/psb_check_mod.f90 @@ -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) diff --git a/src/modules/psb_serial_mod.f90 b/src/modules/psb_serial_mod.f90 index 58f55c0a..87fb9cb4 100644 --- a/src/modules/psb_serial_mod.f90 +++ b/src/modules/psb_serial_mod.f90 @@ -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 diff --git a/src/modules/psb_spmat_type.f90 b/src/modules/psb_spmat_type.f90 index 3996a96a..1b113e68 100644 --- a/src/modules/psb_spmat_type.f90 +++ b/src/modules/psb_spmat_type.f90 @@ -1153,6 +1153,5 @@ contains End Subroutine psb_zsp_free - end module psb_spmat_type diff --git a/src/prec/psb_dasmatbld.f90 b/src/prec/psb_dasmatbld.f90 index b39236f6..865b2bf6 100644 --- a/src/prec/psb_dasmatbld.f90 +++ b/src/prec/psb_dasmatbld.f90 @@ -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() diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index 3c905043..9f263e5c 100644 --- a/src/prec/psb_dbldaggrmat.f90 +++ b/src/prec/psb_dbldaggrmat.f90 @@ -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 ') diff --git a/src/prec/psb_dilu_bld.f90 b/src/prec/psb_dilu_bld.f90 index 4c8fa041..4bdaed25 100644 --- a/src/prec/psb_dilu_bld.f90 +++ b/src/prec/psb_dilu_bld.f90 @@ -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) diff --git a/src/prec/psb_dmlprc_bld.f90 b/src/prec/psb_dmlprc_bld.f90 index 339ba95a..fa40aca4 100644 --- a/src/prec/psb_dmlprc_bld.f90 +++ b/src/prec/psb_dmlprc_bld.f90 @@ -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 diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index 548237ec..46034dce 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -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 diff --git a/src/prec/psb_dprecset.f90 b/src/prec/psb_dprecset.f90 index c46e93ab..2f2a6fde 100644 --- a/src/prec/psb_dprecset.f90 +++ b/src/prec/psb_dprecset.f90 @@ -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 diff --git a/src/prec/psb_zbldaggrmat.f90 b/src/prec/psb_zbldaggrmat.f90 index fb57d93a..e0f3410b 100644 --- a/src/prec/psb_zbldaggrmat.f90 +++ b/src/prec/psb_zbldaggrmat.f90 @@ -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. diff --git a/src/prec/psb_zilu_bld.f90 b/src/prec/psb_zilu_bld.f90 index 57aa9e8b..05170b07 100644 --- a/src/prec/psb_zilu_bld.f90 +++ b/src/prec/psb_zilu_bld.f90 @@ -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 ! diff --git a/src/prec/psb_zmlprc_bld.f90 b/src/prec/psb_zmlprc_bld.f90 index aa496839..da71ab6d 100644 --- a/src/prec/psb_zmlprc_bld.f90 +++ b/src/prec/psb_zmlprc_bld.f90 @@ -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 diff --git a/src/prec/psb_zprecbld.f90 b/src/prec/psb_zprecbld.f90 index 8447a6d9..73eb0099 100644 --- a/src/prec/psb_zprecbld.f90 +++ b/src/prec/psb_zprecbld.f90 @@ -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 diff --git a/src/psblas/psb_dspmm.f90 b/src/psblas/psb_dspmm.f90 index 0bb6b9f8..cf477561 100644 --- a/src/psblas/psb_dspmm.f90 +++ b/src/psblas/psb_dspmm.f90 @@ -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' diff --git a/src/serial/csr/dcsrmv.f b/src/serial/csr/dcsrmv.f index d5866fcf..05d88952 100644 --- a/src/serial/csr/dcsrmv.f +++ b/src/serial/csr/dcsrmv.f @@ -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 diff --git a/src/tools/psb_cdasb.f90 b/src/tools/psb_cdasb.f90 index 992361c0..cad2de0c 100644 --- a/src/tools/psb_cdasb.f90 +++ b/src/tools/psb_cdasb.f90 @@ -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_ diff --git a/src/tools/psb_cdcpy.f90 b/src/tools/psb_cdcpy.f90 index dbbb6298..3bf85000 100644 --- a/src/tools/psb_cdcpy.f90 +++ b/src/tools/psb_cdcpy.f90 @@ -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'