psblas-3.0-maint:

base/modules/psb_indx_map_mod.f90
 krylov/psb_crgmres.f90
 krylov/psb_drgmres.f90
 krylov/psb_srgmres.f90
 krylov/psb_zrgmres.f90
 prec/impl/psb_c_bjacprec_impl.f90
 prec/impl/psb_d_bjacprec_impl.f90
 prec/impl/psb_s_bjacprec_impl.f90
 prec/impl/psb_z_bjacprec_impl.f90

Bug fixes for bjacprec and rgmres.

base/modules/psb_indx_map_mod.f90

@@ -668,7 +668,7 @@ contains
     integer(psb_ipk_), intent(inout) :: idx
     integer(psb_ipk_), intent(out)   :: info 
     logical, intent(in), optional :: mask
-    integer, intent(in), optional :: lidx
+    integer(psb_ipk_), intent(in), optional :: lidx
     integer(psb_ipk_) :: err_act
     character(len=20)  :: name='base_g2l_ins'
     logical, parameter :: debug=.false.
@@ -695,7 +695,7 @@ contains
     integer(psb_ipk_), intent(out)   :: idxout
     integer(psb_ipk_), intent(out)   :: info 
     logical, intent(in), optional :: mask
-    integer, intent(in), optional :: lidx
+    integer(psb_ipk_), intent(in), optional :: lidx
 
     integer(psb_ipk_) :: err_act
     character(len=20)  :: name='base_g2l_ins'
@@ -723,7 +723,7 @@ contains
     integer(psb_ipk_), intent(inout) :: idx(:)
     integer(psb_ipk_), intent(out)   :: info 
     logical, intent(in), optional :: mask(:)
-    integer, intent(in), optional :: lidx(:)
+    integer(psb_ipk_), intent(in), optional :: lidx(:)
 
     integer(psb_ipk_) :: err_act
     character(len=20)  :: name='base_g2l_ins'
@@ -751,7 +751,7 @@ contains
     integer(psb_ipk_), intent(out)   :: idxout(:)
     integer(psb_ipk_), intent(out)   :: info 
     logical, intent(in), optional :: mask(:)
-    integer, intent(in), optional :: lidx(:)
+    integer(psb_ipk_), intent(in), optional :: lidx(:)
 
     integer(psb_ipk_) :: err_act
     character(len=20)  :: name='base_g2l_ins'

krylov/psb_crgmres.f90

@@ -506,7 +506,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
   character(len=*), parameter :: methdname='RGMRES'
 
   info = psb_success_
-  name = 'psb_sgmres'
+  name = 'psb_cgmres'
   call psb_erractionsave(err_act)
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
@@ -717,7 +717,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
       scal=cone/h(i+1,i)
       call psb_geaxpby(scal,w,czero,v(i+1),desc_a,info)
       do k=2,i
-        call crot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1))
+        call crot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_spk_),s(k-1))
       enddo
 
 
@@ -725,9 +725,9 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
       rti1 = h(i+1,i) 
       call crotg(rti,rti1,tmp,s(i))
       c(i) = cmplx(tmp,szero)
-      call crot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i))
+      call crot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_spk_),s(i))
       h(i+1,i) = czero
-      call crot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i))
+      call crot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_spk_),s(i))
       
       if (istop_ == 1) then 
         !

krylov/psb_drgmres.f90

@@ -506,7 +506,7 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,&
   character(len=*), parameter :: methdname='RGMRES'
 
   info = psb_success_
-  name = 'psb_sgmres'
+  name = 'psb_dgmres'
   call psb_erractionsave(err_act)
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
@@ -717,17 +717,17 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,&
       scal=done/h(i+1,i)
       call psb_geaxpby(scal,w,dzero,v(i+1),desc_a,info)
       do k=2,i
-        call drot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1))
+        call drot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_dpk_),s(k-1))
       enddo
 
 
       rti  = h(i,i)
       rti1 = h(i+1,i) 
       call drotg(rti,rti1,tmp,s(i))
-      c(i) = cmplx(tmp,szero)
-      call drot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i))
+      c(i) = cmplx(tmp,dzero)
+      call drot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_dpk_),s(i))
       h(i+1,i) = dzero
-      call drot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i))
+      call drot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_dpk_),s(i))
       
       if (istop_ == 1) then 
         !

krylov/psb_srgmres.f90

@@ -717,7 +717,7 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,&
       scal=sone/h(i+1,i)
       call psb_geaxpby(scal,w,szero,v(i+1),desc_a,info)
       do k=2,i
-        call srot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1))
+        call srot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_spk_),s(k-1))
       enddo
 
 
@@ -725,9 +725,9 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,&
       rti1 = h(i+1,i) 
       call srotg(rti,rti1,tmp,s(i))
       c(i) = cmplx(tmp,szero)
-      call srot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i))
+      call srot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_spk_),s(i))
       h(i+1,i) = szero
-      call srot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i))
+      call srot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_spk_),s(i))
       
       if (istop_ == 1) then 
         !

krylov/psb_zrgmres.f90

@@ -506,7 +506,7 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,&
   character(len=*), parameter :: methdname='RGMRES'
 
   info = psb_success_
-  name = 'psb_sgmres'
+  name = 'psb_zgmres'
   call psb_erractionsave(err_act)
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
@@ -717,17 +717,17 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,&
       scal=zone/h(i+1,i)
       call psb_geaxpby(scal,w,zzero,v(i+1),desc_a,info)
       do k=2,i
-        call zrot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1))
+        call zrot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_dpk_),s(k-1))
       enddo
 
 
       rti  = h(i,i)
       rti1 = h(i+1,i) 
       call zrotg(rti,rti1,tmp,s(i))
-      c(i) = cmplx(tmp,szero)
-      call zrot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i))
+      c(i) = cmplx(tmp,dzero)
+      call zrot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_dpk_),s(i))
       h(i+1,i) = zzero
-      call zrot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i))
+      call zrot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_dpk_),s(i))
       
       if (istop_ == 1) then 
         !

prec/impl/psb_c_bjacprec_impl.f90

@@ -147,7 +147,6 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
   else
     allocate(ww(n_col),aux(4*n_col),stat=info)
   endif
-  if (info == psb_success_) allocate(wv%v,mold=x%v)
 
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
@@ -182,7 +181,7 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
 
       call wv1%mlt(cone,prec%dv,wv,czero,info,conjgx=trans_)
   
-      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,&
            & beta,y,desc_data,info,&
            & trans=trans_,scale='U',choice=psb_none_,work=aux)
 

prec/impl/psb_d_bjacprec_impl.f90

@@ -147,7 +147,6 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
   else
     allocate(ww(n_col),aux(4*n_col),stat=info)
   endif
-  if (info == psb_success_) allocate(wv%v,mold=x%v)
 
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
@@ -182,7 +181,7 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
 
       call wv1%mlt(done,prec%dv,wv,dzero,info,conjgx=trans_)
   
-      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,&
            & beta,y,desc_data,info,&
            & trans=trans_,scale='U',choice=psb_none_,work=aux)
 

prec/impl/psb_s_bjacprec_impl.f90

@@ -147,7 +147,6 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
   else
     allocate(ww(n_col),aux(4*n_col),stat=info)
   endif
-  if (info == psb_success_) allocate(wv%v,mold=x%v)
 
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
@@ -182,7 +181,7 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
 
       call wv1%mlt(sone,prec%dv,wv,szero,info,conjgx=trans_)
   
-      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,&
            & beta,y,desc_data,info,&
            & trans=trans_,scale='U',choice=psb_none_,work=aux)
 

prec/impl/psb_z_bjacprec_impl.f90

@@ -147,7 +147,6 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
   else
     allocate(ww(n_col),aux(4*n_col),stat=info)
   endif
-  if (info == psb_success_) allocate(wv%v,mold=x%v)
 
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
@@ -182,7 +181,7 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
 
       call wv1%mlt(zone,prec%dv,wv,zzero,info,conjgx=trans_)
   
-      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,&
            & beta,y,desc_data,info,&
            & trans=trans_,scale='U',choice=psb_none_,work=aux)