psblas3:

base/modules/psb_desc_mod.F90
 base/tools/psb_glob_to_loc.f90
 test/pargen/ppde2d.f90
 test/pargen/ppde3d.f90
 test/pargen/spde2d.f90
 test/pargen/spde3d.f90

New get_fmt, g2l, l2g methods in desc_type.

base/modules/psb_desc_mod.F90

@@ -231,6 +231,29 @@ module psb_desc_mod
     procedure, pass(desc) :: destroy         => psb_cd_destroy
     procedure, pass(desc) :: nullify         => nullify_desc
 
+    procedure, pass(desc) :: get_fmt         => cd_get_fmt
+    procedure, pass(desc) :: l2gs1           => cd_l2gs1
+    procedure, pass(desc) :: l2gs2           => cd_l2gs2
+    procedure, pass(desc) :: l2gv1           => cd_l2gv1
+    procedure, pass(desc) :: l2gv2           => cd_l2gv2
+    generic, public       :: l2g             => l2gs2, l2gv2
+    generic, public       :: l2gip           => l2gs1, l2gv1                            
+
+    procedure, pass(desc) :: g2ls1           => cd_g2ls1
+    procedure, pass(desc) :: g2ls2           => cd_g2ls2
+    procedure, pass(desc) :: g2lv1           => cd_g2lv1
+    procedure, pass(desc) :: g2lv2           => cd_g2lv2
+    generic, public       :: g2l             => g2ls2, g2lv2
+    generic, public       :: g2lip           => g2ls1, g2lv1
+
+    procedure, pass(desc) :: g2ls1_ins       => cd_g2ls1_ins
+    procedure, pass(desc) :: g2ls2_ins       => cd_g2ls2_ins
+    procedure, pass(desc) :: g2lv1_ins       => cd_g2lv1_ins
+    procedure, pass(desc) :: g2lv2_ins       => cd_g2lv2_ins
+    generic, public       :: g2l_ins         => g2ls2_ins, g2lv2_ins
+    generic, public       :: g2lip_ins       => g2ls1_ins, g2lv1_ins
+    
+
   end type psb_desc_type
 
 
@@ -256,7 +279,11 @@ module psb_desc_mod
   end interface psb_free
 
 
-  private :: nullify_desc
+  private :: nullify_desc, cd_get_fmt,&
+       & cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,&
+       & cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,&
+       & cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins
+
 
   integer(psb_ipk_), private, save :: cd_large_threshold=psb_default_large_threshold 
 
@@ -464,6 +491,19 @@ contains
 
   end function psb_cd_get_global_cols
 
+  function cd_get_fmt(desc) result(val)
+    implicit none 
+    character(len=5) :: val 
+    class(psb_desc_type), intent(in) :: desc
+
+    if (allocated(desc%indxmap)) then 
+      val = desc%indxmap%get_fmt()
+    else
+      val = 'NULL'
+    endif
+
+  end function cd_get_fmt
+
   function psb_cd_get_context(desc) result(val)
     use psb_error_mod
     implicit none 
@@ -910,5 +950,488 @@ contains
   end Subroutine psb_cd_get_recv_idx
 
 
+  subroutine cd_l2gs1(idx,desc,info,mask,owned)
+    use psb_error_mod 
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(inout) :: idx
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask
+    logical, intent(in), optional :: owned
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_l2g'
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%l2gs1(idx,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+  end subroutine cd_l2gs1
+
+  subroutine cd_l2gs2(idxin,idxout,desc,info,mask,owned)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(in)    :: idxin
+    integer(psb_ipk_), intent(out)   :: idxout
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask
+    logical, intent(in), optional :: owned
+
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_l2g'
+    logical, parameter :: debug=.false.
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%l2gs2(idxin,idxout,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+
+  end subroutine cd_l2gs2
+
+
+  subroutine cd_l2gv1(idx,desc,info,mask,owned)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(inout) :: idx(:)
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask(:)
+    logical, intent(in), optional :: owned
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_l2g'
+    logical, parameter :: debug=.false.
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%l2gv1(idx,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+  end subroutine cd_l2gv1
+
+  subroutine cd_l2gv2(idxin,idxout,desc,info,mask,owned)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(in)    :: idxin(:)
+    integer(psb_ipk_), intent(out)   :: idxout(:)
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask(:)
+    logical, intent(in), optional :: owned
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_l2g'
+    logical, parameter :: debug=.false.
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%l2gv2(idxin,idxout,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+  end subroutine cd_l2gv2
+
+
+  subroutine cd_g2ls1(idx,desc,info,mask,owned)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(inout) :: idx
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask
+    logical, intent(in), optional :: owned
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l'
+    logical, parameter :: debug=.false.
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2ls1(idx,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+  end subroutine cd_g2ls1
+
+  subroutine cd_g2ls2(idxin,idxout,desc,info,mask,owned)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(in)    :: idxin
+    integer(psb_ipk_), intent(out)   :: idxout
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask
+    logical, intent(in), optional :: owned
+
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l'
+    logical, parameter :: debug=.false.
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2ls2(idxin,idxout,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+
+  end subroutine cd_g2ls2
+
+
+  subroutine cd_g2lv1(idx,desc,info,mask,owned)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(inout) :: idx(:)
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask(:)
+    logical, intent(in), optional :: owned
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l'
+    logical, parameter :: debug=.false.
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2lv1(idx,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+
+  end subroutine cd_g2lv1
+
+  subroutine cd_g2lv2(idxin,idxout,desc,info,mask,owned)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(in) :: desc
+    integer(psb_ipk_), intent(in)    :: idxin(:)
+    integer(psb_ipk_), intent(out)   :: idxout(:)
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask(:)
+    logical, intent(in), optional :: owned
+
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l'
+    logical, parameter :: debug=.false.
+
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2lv2(idxin,idxout,info,mask=mask,owned=owned)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+
+  end subroutine cd_g2lv2
+
+
+
+  subroutine cd_g2ls1_ins(idx,desc,info,mask, lidx)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(inout) :: desc
+    integer(psb_ipk_), intent(inout) :: idx
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask
+    integer(psb_ipk_), intent(in), optional :: lidx
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l_ins'
+    logical, parameter :: debug=.false.
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2ls1_ins(idx,info,mask=mask,lidx=lidx)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+
+  end subroutine cd_g2ls1_ins
+
+  subroutine cd_g2ls2_ins(idxin,idxout,desc,info,mask, lidx)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(inout) :: desc
+    integer(psb_ipk_), intent(in)    :: idxin
+    integer(psb_ipk_), intent(out)   :: idxout
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask
+    integer(psb_ipk_), intent(in), optional :: lidx
+
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l_ins'
+    logical, parameter :: debug=.false.
+
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2ls2_ins(idxin,idxout,info,mask=mask,lidx=lidx)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+
+  end subroutine cd_g2ls2_ins
+
+
+  subroutine cd_g2lv1_ins(idx,desc,info,mask, lidx)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(inout) :: desc
+    integer(psb_ipk_), intent(inout) :: idx(:)
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask(:)
+    integer(psb_ipk_), intent(in), optional :: lidx(:)
+
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l_ins'
+    logical, parameter :: debug=.false.
+
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2lv1_ins(idx,info,mask=mask,lidx=lidx)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+
+  end subroutine cd_g2lv1_ins
+
+  subroutine cd_g2lv2_ins(idxin,idxout,desc,info,mask,lidx)
+    use psb_error_mod
+    implicit none 
+    class(psb_desc_type), intent(inout) :: desc
+    integer(psb_ipk_), intent(in)    :: idxin(:)
+    integer(psb_ipk_), intent(out)   :: idxout(:)
+    integer(psb_ipk_), intent(out)   :: info 
+    logical, intent(in), optional :: mask(:)
+    integer(psb_ipk_), intent(in), optional :: lidx(:)
+
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='cd_g2l_ins'
+    logical, parameter :: debug=.false.
+
+
+    info  = psb_success_
+    call psb_erractionsave(err_act)
+
+    if (allocated(desc%indxmap)) then 
+      call desc%indxmap%g2lv2_ins(idxin,idxout,info,mask=mask,lidx=lidx)
+    else
+      info = psb_err_invalid_cd_state_
+    end if
+    if (info /= psb_success_) then 
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    Return
+
+  end subroutine cd_g2lv2_ins
 
 end module psb_desc_mod

base/tools/psb_glob_to_loc.f90

@@ -62,7 +62,6 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
   integer(psb_ipk_) :: n, ictxt, iam, np 
   character                          :: act
   integer(psb_ipk_) :: int_err(5), err_act
-  logical                            :: owned_
   integer(psb_ipk_), parameter                 :: zero=0
   character(len=20)   :: name
 
@@ -191,7 +190,6 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
   integer(psb_ipk_) :: n
   character                        :: act
   integer(psb_ipk_) :: err_act
-  logical                          :: owned_
   integer(psb_ipk_), parameter               :: zero=0
   character(len=20)   :: name
   integer(psb_ipk_) :: ictxt, iam, np

test/pargen/ppde2d.f90

@@ -243,7 +243,7 @@ program ppde2d
     write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
     write(psb_out_unit,'("Total memory occupation for PREC:   ",i12)')precsize    
     write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
-    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
+    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt()
   end if
 
 

test/pargen/ppde3d.f90

@@ -256,7 +256,7 @@ program ppde3d
     write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
     write(psb_out_unit,'("Total memory occupation for PREC:   ",i12)')precsize    
     write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
-    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
+    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt()
   end if
 
 

test/pargen/spde2d.f90

@@ -242,7 +242,7 @@ program spde2d
     write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
     write(psb_out_unit,'("Total memory occupation for PREC:   ",i12)')precsize    
     write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
-    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
+    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt()
   end if
 
 

test/pargen/spde3d.f90

@@ -256,7 +256,7 @@ program spde3d
     write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
     write(psb_out_unit,'("Total memory occupation for PREC:   ",i12)')precsize    
     write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
-    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
+    write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt()
   end if