psblas3:

Reworked preconditioner stuff. Currently contains some debug
statements. 



 base/modules/psb_c_mat_mod.f03
 base/modules/psb_d_base_mat_mod.f03
 base/modules/psb_d_mat_mod.f03
 base/modules/psb_error_mod.F90
 base/serial/f03/psb_d_csr_impl.f03
 base/serial/f03/psb_s_csr_impl.f03
 base/tools/psb_cspasb.f90
 base/tools/psb_dspasb.f90
 prec/Makefile
 prec/psb_c_bjacprec.f03
 prec/psb_c_diagprec.f03
 prec/psb_c_nullprec.f03
 prec/psb_cbjac_aply.f90
 prec/psb_cbjac_bld.f90
 prec/psb_cdiagsc_bld.f90
 prec/psb_cgprec_aply.f90
 prec/psb_cilu_fct.f90
 prec/psb_cprc_aply.f90
 prec/psb_cprecbld.f90
 prec/psb_cprecinit.f90
 prec/psb_cprecset.f90
 prec/psb_d_bjacprec.f03
 prec/psb_dbjac_aply.f90
 prec/psb_dbjac_bld.f90
 prec/psb_ddiagsc_bld.f90
 prec/psb_dgprec_aply.f90
 prec/psb_dprc_aply.f90
 prec/psb_dprecbld.f90
 prec/psb_dprecinit.f90
 prec/psb_dprecset.f90
 prec/psb_prec_type.f03
 prec/psb_s_bjacprec.f03
 prec/psb_s_diagprec.f03
 prec/psb_s_nullprec.f03
 prec/psb_sbjac_aply.f90
 prec/psb_sbjac_bld.f90
 prec/psb_sdiagsc_bld.f90
 prec/psb_sgprec_aply.f90
 prec/psb_silu_fct.f90
 prec/psb_sprc_aply.f90
 prec/psb_sprecbld.f90
 prec/psb_sprecinit.f90
 prec/psb_sprecset.f90
 prec/psb_z_bjacprec.f03
 prec/psb_z_diagprec.f03
 prec/psb_z_nullprec.f03
 prec/psb_zbjac_aply.f90
 prec/psb_zbjac_bld.f90
 prec/psb_zdiagsc_bld.f90
 prec/psb_zgprec_aply.f90
 prec/psb_zilu_fct.f90
 prec/psb_zprc_aply.f90
 prec/psb_zprecbld.f90
 prec/psb_zprecinit.f90
 prec/psb_zprecset.f90
 test/fileread/runs/cfs.inp
 test/fileread/runs/dfs.inp
 test/fileread/runs/zfs.inp
 test/pargen/Makefile
 test/pargen/runs/ppde.inp
 util/psb_mat_dist_mod.f90

base/modules/psb_c_mat_mod.f03

@@ -1426,6 +1426,7 @@ contains
       call a%set_dupl(psb_dupl_def_)
     end if
 
+    write(0,*)name,' ', present(mold), present(type),count( (/present(mold),present(type) /))
     if (count( (/present(mold),present(type) /)) > 1) then
       info = 583
       call psb_errpush(info,name,a_err='TYPE, MOLD')

base/modules/psb_d_base_mat_mod.f03

@@ -1258,7 +1258,7 @@ contains
         
         allocate(tmp(nac),stat=info) 
         if (info /= 0) info = 4000 
-        if (info == 0) tmp(1:nac) = d(1:nac)*x(1:nac) 
+        if (info == 0) call inner_vscal(nac,d,x,tmp) 
         if (info == 0)&
              & call a%base_cssm(alpha,tmp,beta,y,info,trans)
         
@@ -1273,19 +1273,23 @@ contains
           call psb_errpush(info,name,i_err=(/9,nar,0,0,0/))
           goto 9999
         end if
-        
-        allocate(tmp(nar),stat=info) 
-        if (info /= 0) info = 4000 
-        if (info == 0)&
-             & call a%base_cssm(done,x,dzero,tmp,info,trans)
 
-        if (info == 0) tmp(1:nar) = d(1:nar)*tmp(1:nar) 
-        if (info == 0)&
-             & call psb_geaxpby(nar,alpha,tmp,beta,y,info)
-        
-        if (info == 0) then 
-          deallocate(tmp,stat=info) 
-          if (info /= 0) info = 4000
+        if (beta == dzero) then 
+          call a%base_cssm(alpha,x,dzero,y,info,trans)
+          if (info == 0)  call inner_vscal1(nar,d,y)
+        else
+          allocate(tmp(nar),stat=info) 
+          if (info /= 0) info = 4000 
+          if (info == 0)&
+               & call a%base_cssm(alpha,x,dzero,tmp,info,trans)
+          
+          if (info == 0)  call inner_vscal1(nar,d,tmp)
+          if (info == 0)&
+               & call psb_geaxpby(nar,done,tmp,beta,y,info)
+          if (info == 0) then 
+            deallocate(tmp,stat=info) 
+            if (info /= 0) info = 4000
+          end if
         end if
         
       else
@@ -1318,8 +1322,31 @@ contains
       return
     end if
     return
-
-
+  contains
+    subroutine inner_vscal(n,d,x,y)
+      implicit none 
+      integer, intent(in)         :: n
+      real(psb_dpk_), intent(in)  :: d(*),x(*)
+      real(psb_dpk_), intent(out) :: y(*)
+      integer :: i
+      
+      do i=1,n
+        y(i) = d(i)*x(i) 
+      end do
+    end subroutine inner_vscal
+    
+    subroutine inner_vscal1(n,d,x)
+      implicit none 
+      integer, intent(in)         :: n
+      real(psb_dpk_), intent(in)  :: d(*)
+      real(psb_dpk_), intent(inout) :: x(*)
+      integer :: i
+      
+      do i=1,n
+        x(i) = d(i)*x(i) 
+      end do
+    end subroutine inner_vscal1
+    
   end subroutine d_cssv
 
 

base/modules/psb_d_mat_mod.f03

@@ -1485,6 +1485,7 @@ contains
       call a%set_dupl(psb_dupl_def_)
     end if
 
+    write(0,*)name,' ', present(mold), present(type),count( (/present(mold),present(type) /))
     if (count( (/present(mold),present(type) /)) > 1) then
       info = 583
       call psb_errpush(info,name,a_err='TYPE, MOLD')

base/modules/psb_error_mod.F90

@@ -490,7 +490,9 @@ contains
       write (0,'("Invalid state for communication descriptor")')
     case (1123)
       write (0,'("Invalid combined state for A and DESC_A")')
-    case(1124:1999)
+    case (1124)
+      write (0,'("Invalid state for object:",a)') trim(a_e_d)
+    case(1125:1999)
       write (0,'("computational error. code: ",i0)')err_c
     case(2010)
       write (0,'("BLACS error. Number of processes=-1")')