mld2p4-2:

mlprec/impl/smoother/mld_c_as_smoother_apply.f90
 mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90
 mlprec/impl/smoother/mld_d_as_smoother_apply.f90
 mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90
 mlprec/impl/smoother/mld_s_as_smoother_apply.f90
 mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90
 mlprec/impl/smoother/mld_z_as_smoother_apply.f90
 mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90

Fix usage of init/initu for AS

mlprec/impl/smoother/mld_c_as_smoother_apply.f90

@@ -54,7 +54,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   complex(psb_spk_),intent(inout), optional :: initu(:)
 
   integer(psb_ipk_)  :: n_row,n_col, nrow_d, i
-  complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  complex(psb_spk_), pointer :: ww(:), aux(:)
+  complex(psb_spk_), allocatable  :: tx(:),ty(:)
   integer(psb_ipk_)  :: ictxt,np,me, err_act,isz,int_err(5)
   character          :: trans_, init_
   character(len=20)  :: name='c_as_smoother_apply', ch_err
@@ -95,12 +96,10 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
 
   if ((6*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     aux => work(3*isz+1:)
   else if ((4*isz) <= size(work)) then 
     aux => work(1:)
-    allocate(ww(isz),tx(isz),ty(isz),stat=info)
+    allocate(ww(isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/3*isz,izero,izero,izero,izero/),&
@@ -109,8 +108,6 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
     end if
   else if ((3*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     allocate(aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
@@ -119,8 +116,7 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
       goto 9999      
     end if
   else 
-    allocate(ww(isz),tx(isz),ty(isz),&
-         &aux(4*isz),stat=info)
+    allocate(ww(isz), aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/4*isz,izero,izero,izero,izero/),&
@@ -154,8 +150,26 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   else 
 
 
-    tx(1:nrow_d)     = x(1:nrow_d) 
-    tx(nrow_d+1:isz) = czero
+    call psb_geasb(tx,desc_data,info)
+    call psb_geasb(ty,desc_data,info)
+
+    select case (init_)
+    case('Z') 
+      tx(:) = czero
+    case('Y')
+      call psb_geaxpby(cone,y,czero,tx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(cone,initu,czero,tx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
 
     if (sweeps == 1) then 

mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90

@@ -155,21 +155,27 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
 
   else 
 
-
-    vx = x%get_vect()
-
-    call psb_geall(vtx,sm%desc_data,info)
-    call psb_geasb(vtx,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vty,sm%desc_data,info)
-    call psb_geasb(vty,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vww,sm%desc_data,info)
-    call psb_geasb(vww,sm%desc_data,info,mold=x%v) 
-    call vtx%set(czero)
-    call vty%set(czero)
-    call vww%set(czero)
-
-
-    call vtx%set(vx(1:nrow_d))
+    call psb_geasb(vtx,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vty,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vww,sm%desc_data,info,mold=x%v,scratch=.true.) 
+
+    select case (init_)
+    case('Z') 
+      call vtx%zero()
+    case('Y')
+      call psb_geaxpby(cone,y,czero,vtx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(cone,initu,czero,vtx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
     if (sweeps == 1) then 
 

mlprec/impl/smoother/mld_d_as_smoother_apply.f90

@@ -54,7 +54,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   real(psb_dpk_),intent(inout), optional :: initu(:)
 
   integer(psb_ipk_)  :: n_row,n_col, nrow_d, i
-  real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  real(psb_dpk_), pointer :: ww(:), aux(:)
+  real(psb_dpk_), allocatable  :: tx(:),ty(:)
   integer(psb_ipk_)  :: ictxt,np,me, err_act,isz,int_err(5)
   character          :: trans_, init_
   character(len=20)  :: name='d_as_smoother_apply', ch_err
@@ -95,12 +96,10 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
 
   if ((6*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     aux => work(3*isz+1:)
   else if ((4*isz) <= size(work)) then 
     aux => work(1:)
-    allocate(ww(isz),tx(isz),ty(isz),stat=info)
+    allocate(ww(isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/3*isz,izero,izero,izero,izero/),&
@@ -109,8 +108,6 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
     end if
   else if ((3*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     allocate(aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
@@ -119,8 +116,7 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
       goto 9999      
     end if
   else 
-    allocate(ww(isz),tx(isz),ty(isz),&
-         &aux(4*isz),stat=info)
+    allocate(ww(isz), aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/4*isz,izero,izero,izero,izero/),&
@@ -154,8 +150,26 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   else 
 
 
-    tx(1:nrow_d)     = x(1:nrow_d) 
-    tx(nrow_d+1:isz) = dzero
+    call psb_geasb(tx,desc_data,info)
+    call psb_geasb(ty,desc_data,info)
+
+    select case (init_)
+    case('Z') 
+      tx(:) = dzero
+    case('Y')
+      call psb_geaxpby(done,y,dzero,tx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(done,initu,dzero,tx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
 
     if (sweeps == 1) then 

mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90

@@ -155,21 +155,27 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
 
   else 
 
-
-    vx = x%get_vect()
-
-    call psb_geall(vtx,sm%desc_data,info)
-    call psb_geasb(vtx,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vty,sm%desc_data,info)
-    call psb_geasb(vty,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vww,sm%desc_data,info)
-    call psb_geasb(vww,sm%desc_data,info,mold=x%v) 
-    call vtx%set(dzero)
-    call vty%set(dzero)
-    call vww%set(dzero)
-
-
-    call vtx%set(vx(1:nrow_d))
+    call psb_geasb(vtx,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vty,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vww,sm%desc_data,info,mold=x%v,scratch=.true.) 
+
+    select case (init_)
+    case('Z') 
+      call vtx%zero()
+    case('Y')
+      call psb_geaxpby(done,y,dzero,vtx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(done,initu,dzero,vtx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
     if (sweeps == 1) then 
 

mlprec/impl/smoother/mld_s_as_smoother_apply.f90

@@ -54,7 +54,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   real(psb_spk_),intent(inout), optional :: initu(:)
 
   integer(psb_ipk_)  :: n_row,n_col, nrow_d, i
-  real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  real(psb_spk_), pointer :: ww(:), aux(:)
+  real(psb_spk_), allocatable  :: tx(:),ty(:)
   integer(psb_ipk_)  :: ictxt,np,me, err_act,isz,int_err(5)
   character          :: trans_, init_
   character(len=20)  :: name='s_as_smoother_apply', ch_err
@@ -95,12 +96,10 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
 
   if ((6*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     aux => work(3*isz+1:)
   else if ((4*isz) <= size(work)) then 
     aux => work(1:)
-    allocate(ww(isz),tx(isz),ty(isz),stat=info)
+    allocate(ww(isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/3*isz,izero,izero,izero,izero/),&
@@ -109,8 +108,6 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
     end if
   else if ((3*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     allocate(aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
@@ -119,8 +116,7 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
       goto 9999      
     end if
   else 
-    allocate(ww(isz),tx(isz),ty(isz),&
-         &aux(4*isz),stat=info)
+    allocate(ww(isz), aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/4*isz,izero,izero,izero,izero/),&
@@ -154,8 +150,26 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   else 
 
 
-    tx(1:nrow_d)     = x(1:nrow_d) 
-    tx(nrow_d+1:isz) = szero
+    call psb_geasb(tx,desc_data,info)
+    call psb_geasb(ty,desc_data,info)
+
+    select case (init_)
+    case('Z') 
+      tx(:) = szero
+    case('Y')
+      call psb_geaxpby(sone,y,szero,tx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(sone,initu,szero,tx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
 
     if (sweeps == 1) then 

mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90

@@ -155,21 +155,27 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
 
   else 
 
-
-    vx = x%get_vect()
-
-    call psb_geall(vtx,sm%desc_data,info)
-    call psb_geasb(vtx,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vty,sm%desc_data,info)
-    call psb_geasb(vty,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vww,sm%desc_data,info)
-    call psb_geasb(vww,sm%desc_data,info,mold=x%v) 
-    call vtx%set(szero)
-    call vty%set(szero)
-    call vww%set(szero)
-
-
-    call vtx%set(vx(1:nrow_d))
+    call psb_geasb(vtx,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vty,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vww,sm%desc_data,info,mold=x%v,scratch=.true.) 
+
+    select case (init_)
+    case('Z') 
+      call vtx%zero()
+    case('Y')
+      call psb_geaxpby(sone,y,szero,vtx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(sone,initu,szero,vtx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
     if (sweeps == 1) then 
 

mlprec/impl/smoother/mld_z_as_smoother_apply.f90

@@ -54,7 +54,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   complex(psb_dpk_),intent(inout), optional :: initu(:)
 
   integer(psb_ipk_)  :: n_row,n_col, nrow_d, i
-  complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  complex(psb_dpk_), pointer :: ww(:), aux(:)
+  complex(psb_dpk_), allocatable  :: tx(:),ty(:)
   integer(psb_ipk_)  :: ictxt,np,me, err_act,isz,int_err(5)
   character          :: trans_, init_
   character(len=20)  :: name='z_as_smoother_apply', ch_err
@@ -95,12 +96,10 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
 
   if ((6*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     aux => work(3*isz+1:)
   else if ((4*isz) <= size(work)) then 
     aux => work(1:)
-    allocate(ww(isz),tx(isz),ty(isz),stat=info)
+    allocate(ww(isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/3*isz,izero,izero,izero,izero/),&
@@ -109,8 +108,6 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
     end if
   else if ((3*isz) <= size(work)) then 
     ww => work(1:isz)
-    tx => work(isz+1:2*isz)
-    ty => work(2*isz+1:3*isz)
     allocate(aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
@@ -119,8 +116,7 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
       goto 9999      
     end if
   else 
-    allocate(ww(isz),tx(isz),ty(isz),&
-         &aux(4*isz),stat=info)
+    allocate(ww(isz), aux(4*isz),stat=info)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_alloc_request_,name,&
            & i_err=(/4*isz,izero,izero,izero,izero/),&
@@ -154,8 +150,26 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
   else 
 
 
-    tx(1:nrow_d)     = x(1:nrow_d) 
-    tx(nrow_d+1:isz) = zzero
+    call psb_geasb(tx,desc_data,info)
+    call psb_geasb(ty,desc_data,info)
+
+    select case (init_)
+    case('Z') 
+      tx(:) = zzero
+    case('Y')
+      call psb_geaxpby(zone,y,zzero,tx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(zone,initu,zzero,tx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
 
     if (sweeps == 1) then 

mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90

@@ -155,21 +155,27 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
 
   else 
 
-
-    vx = x%get_vect()
-
-    call psb_geall(vtx,sm%desc_data,info)
-    call psb_geasb(vtx,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vty,sm%desc_data,info)
-    call psb_geasb(vty,sm%desc_data,info,mold=x%v) 
-    call psb_geall(vww,sm%desc_data,info)
-    call psb_geasb(vww,sm%desc_data,info,mold=x%v) 
-    call vtx%set(zzero)
-    call vty%set(zzero)
-    call vww%set(zzero)
-
-
-    call vtx%set(vx(1:nrow_d))
+    call psb_geasb(vtx,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vty,sm%desc_data,info,mold=x%v,scratch=.true.) 
+    call psb_geasb(vww,sm%desc_data,info,mold=x%v,scratch=.true.) 
+
+    select case (init_)
+    case('Z') 
+      call vtx%zero()
+    case('Y')
+      call psb_geaxpby(zone,y,zzero,vtx,desc_data,info)
+    case('U')
+      if (.not.present(initu)) then
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='missing initu to smoother_apply')
+        goto 9999
+      end if
+      call psb_geaxpby(zone,initu,zzero,vtx,desc_data,info)
+    case default
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='wrong  init to smoother_apply')
+      goto 9999
+    end select
 
     if (sweeps == 1) then