Fixed some internal declarations to be allocatable instead of pointers.

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..
+  !     ...local arrays..
-  integer,pointer :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
+  integer,allocatable  :: brvindx(:),rvsz(:),&
+       & bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
 
   integer :: ihinsz,ntot,k,err_act, l_di, &
        & idxr, idxs, iszs, iszr, nesd, nerv, icomm

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

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
+  type(psb_desc_type),target  :: desc_a
-  integer, optional        :: data
+  integer, optional    :: data
 
   ! locals
   integer  :: ictxt, np, me, point_to_proc, nesd, nerv,&

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

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(in)  :: flag
-  integer, intent(out)     :: info
+  integer, intent(out) :: info
-  integer                  :: y(:), beta
+  integer              :: y(:), beta
-  integer, target          :: work(:)
+  integer, target :: work(:)
-  type(psb_desc_type)      :: desc_a
+  type(psb_desc_type),target  :: desc_a
-  integer, optional        :: data
+  integer, optional    :: data
 
   ! locals
   integer  :: ictxt, np, me, point_to_proc, nesd, nerv,&

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

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
+  type(psb_desc_type),target       :: desc_a
-  integer, optional        :: data
+  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
+  type(psb_desc_type),target  :: desc_a
-  integer, optional        :: data
+  integer, optional    :: data
 
   ! locals
   integer  :: ictxt, np, me, point_to_proc, nesd, nerv,&

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)
 

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

src/modules/psb_spmat_type.f90

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

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()
 

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 ')    
 

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)
 

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

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 

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

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.

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
   !                                                                               

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

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

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'

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
+          else if (beta==one) then 
-            DO 240 I = 1, M
+
-              ACC = ZERO
+            if (alpha==one) then 
-              DO 220 J = IA(I), IA(I+1) - 1
+              do i = 1, m
-                ACC = ACC + AS(J)*X(JA(J))
+                acc = y(i)
- 220          CONTINUE
+                do j = ia(i), ia(i+1) - 1
-              Y(I) = ALPHA*ACC + BETA*Y(I)
+                  acc = acc + as(j)*x(ja(j))
- 240        CONTINUE
+                enddo
-          ELSE
+                y(i) = acc
-            DO I = 1, M
+              enddo
-              ACC = ZERO
+            else if (alpha==-one) then 
-              DO J = IA(I), IA(I+1) - 1
+              do i = 1, m
-                ACC = ACC + AS(J)*X(JA(J))
+                acc = y(i)
-              ENDDO
+                do j = ia(i), ia(i+1) - 1
-              Y(I) = ALPHA*ACC
+                  acc = acc - as(j)*x(ja(j))
-            ENDDO
+                enddo
-          ENDIF
+                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

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_

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'