Added use of WV in solve apply_vect

mlprec/impl/solver/mld_c_bwgs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_c_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_c_vect_type)  :: tw, xit
   complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   complex(psb_spk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_c_gs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_c_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_c_vect_type)  :: tw, xit
   complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   complex(psb_spk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90

@@ -125,8 +125,16 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  
+  associate(tw => wv(1), tw1 => wv(2))
 
     select case(trans_)
     case('N')
@@ -165,8 +173,8 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call tw1%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_d_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_d_vect_type)  :: tw, xit
   real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   real(psb_dpk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_d_gs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_d_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_d_vect_type)  :: tw, xit
   real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   real(psb_dpk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90

@@ -125,8 +125,16 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  
+  associate(tw => wv(1), tw1 => wv(2))
 
     select case(trans_)
     case('N')
@@ -165,8 +173,8 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call tw1%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_s_bwgs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_s_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_s_vect_type)  :: tw, xit
   real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   real(psb_spk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_s_gs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_s_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_s_vect_type)  :: tw, xit
   real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   real(psb_spk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90

@@ -125,8 +125,16 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  
+  associate(tw => wv(1), tw1 => wv(2))
 
     select case(trans_)
     case('N')
@@ -165,8 +173,8 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call tw1%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_z_bwgs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_z_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_z_vect_type)  :: tw, xit
   complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   complex(psb_dpk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_z_gs_solver_apply_vect.f90

@@ -54,7 +54,6 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_z_vect_type),intent(inout), optional   :: initu
 
   integer(psb_ipk_)   :: n_row,n_col, itx
-  type(psb_z_vect_type)  :: tw, xit
   complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
   complex(psb_dpk_), allocatable :: temp(:)
   integer(psb_ipk_)   :: ictxt,np,me,i, err_act
@@ -121,8 +120,15 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) 
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  associate(tw => wv(1), xit => wv(2))
+
     select case (init_)
     case('Z') 
       call xit%zero()
@@ -182,8 +188,8 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call xit%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else

mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90

@@ -125,8 +125,16 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
     goto 9999      
   end if
 
-  call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) 
-  call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  if (size(wv) < 2) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,&
+         & a_err='invalid wv size')
+    goto 9999
+  end if
+
+  
+  associate(tw => wv(1), tw1 => wv(2))
 
     select case(trans_)
     case('N')
@@ -165,8 +173,8 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
            & a_err='Error in subsolve')
       goto 9999
     endif
-  call tw%free(info)
-  call tw1%free(info)
+  end associate
+  
   if (n_col <= size(work)) then 
     if ((4*n_col+n_col) <= size(work)) then 
     else