psblas3:

base/modules/psb_base_mat_mod.f03
 base/modules/psb_d_base_mat_mod.f03
 base/modules/psb_d_mat_mod.f03

First version of transpose, only for D for the time being.

base/modules/psb_base_mat_mod.f03

@@ -81,6 +81,12 @@ module psb_base_mat_mod
     generic, public    :: cp_from => base_cp_from
     procedure, pass(a) :: base_mv_from
     generic, public    :: mv_from => base_mv_from
+    procedure, pass(a) :: base_transp_1mat
+    procedure, pass(a) :: base_transp_2mat
+    generic, public    :: transp => base_transp_1mat, base_transp_2mat
+    procedure, pass(a) :: base_transc_1mat
+    procedure, pass(a) :: base_transc_2mat
+    generic, public    :: transc => base_transc_1mat, base_transc_2mat
 
   end type psb_base_sparse_mat
 
@@ -91,7 +97,8 @@ module psb_base_mat_mod
        & is_upd, is_asb, is_sorted, is_upper, is_lower, is_triangle, &
        & is_unit, get_neigh, allocate_mn, allocate_mnnz, reallocate_nz, &
        & free, sparse_print, get_fmt, trim, sizeof, reinit, csgetptn, &
-       & get_nz_row, get_aux, set_aux, base_cp_from, base_mv_from
+       & get_nz_row, get_aux, set_aux, base_cp_from, base_mv_from, &
+       & base_transp_1mat, base_transp_2mat,  base_transc_1mat, base_transc_2mat
   
 contains
 
@@ -481,6 +488,72 @@ contains
 
   end subroutine base_cp_from
 
+
+  !
+  ! Here we go. 
+  !
+  subroutine base_transp_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)  :: b
+    
+    a%m         = b%n
+    a%n         = b%m
+    a%state     = b%state
+    a%duplicate = b%duplicate
+    a%triangle  = b%triangle
+    a%unitd     = b%unitd
+    a%upper     = .not.b%upper
+    a%sorted    = .false.
+    a%aux       = b%aux 
+    
+    return
+    
+  end subroutine base_transp_2mat
+
+  subroutine base_transc_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+
+    call a%transp(b) 
+  end subroutine base_transc_2mat
+
+  subroutine base_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_base_sparse_mat), intent(inout) :: a
+    integer :: itmp
+
+    itmp        = a%m
+    a%m         = a%n
+    a%n         = itmp
+    a%state     = a%state
+    a%duplicate = a%duplicate
+    a%triangle  = a%triangle
+    a%unitd     = a%unitd
+    a%upper     = .not.a%upper
+    a%sorted    = .false.
+    
+    return
+    
+  end subroutine base_transp_1mat
+
+  subroutine base_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_base_sparse_mat), intent(inout) :: a
+    
+    call a%transp() 
+  end subroutine base_transc_1mat
+
+
   subroutine sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
     use psb_error_mod
     implicit none 

base/modules/psb_d_base_mat_mod.f03

@@ -36,6 +36,12 @@ module psb_d_base_mat_mod
     generic, public    :: cp_from => d_base_cp_from
     procedure, pass(a) :: d_base_mv_from
     generic, public    :: mv_from => d_base_mv_from
+
+    procedure, pass(a) :: base_transp_1mat => d_base_transp_1mat
+    procedure, pass(a) :: base_transp_2mat => d_base_transp_2mat
+    procedure, pass(a) :: base_transc_1mat => d_base_transc_1mat
+    procedure, pass(a) :: base_transc_2mat => d_base_transc_2mat
+
   end type psb_d_base_sparse_mat
 
   private :: d_base_csmv, d_base_csmm, d_base_cssv, d_base_cssm,&
@@ -88,6 +94,8 @@ module psb_d_base_mat_mod
     generic, public    :: cp_from => d_coo_cp_from
     procedure, pass(a) :: d_coo_mv_from
     generic, public    :: mv_from => d_coo_mv_from
+    procedure, pass(a) :: base_transp_1mat => d_coo_transp_1mat
+    procedure, pass(a) :: base_transc_1mat => d_coo_transc_1mat
     
   end type psb_d_coo_sparse_mat
 
@@ -99,7 +107,8 @@ module psb_d_base_mat_mod
        & d_cp_coo_to_fmt, d_cp_coo_from_fmt, &
        & d_coo_scals, d_coo_scal, d_coo_csgetrow, d_coo_sizeof, &
        & d_coo_csgetptn, d_coo_get_nz_row, d_coo_reinit,&
-       & d_coo_cp_from, d_coo_mv_from
+       & d_coo_cp_from, d_coo_mv_from, &
+       & d_coo_transp_1mat, d_coo_transc_1mat
 
   
   interface 
@@ -780,6 +789,160 @@ contains
 
 
 
+  !
+  ! Here we go. 
+  !
+!!$  subroutine d_coo_transp_2mat(a,b)
+!!$    use psb_error_mod
+!!$    implicit none 
+!!$    
+!!$    class(psb_d_coo_sparse_mat), intent(out) :: a
+!!$    type(psb_d_coo_sparse_mat), intent(in)   :: b
+!!$    
+!!$    call a%psb_d_base_sparse_mat%psb_base_sparse_mat%transp(b%psb_d_base_sparse_mat%psb_base_sparse_mat) 
+!!$    a%ia = b%ja
+!!$    a%ja = b%ia
+!!$    a%val = b%val 
+!!$    
+!!$    call a%fix()
+!!$
+!!$    return
+!!$    
+!!$  end subroutine d_coo_transp_2mat
+!!$
+!!$  subroutine d_coo_transc_2mat(a,b)
+!!$    use psb_error_mod
+!!$    implicit none 
+!!$    
+!!$    class(psb_d_coo_sparse_mat), intent(out) :: a
+!!$    class(psb_d_coo_sparse_mat), intent(in)   :: b
+!!$    
+!!$    call a%transp(b) 
+!!$  end subroutine d_coo_transc_2mat
+!!$
+  subroutine d_coo_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_d_coo_sparse_mat), intent(inout) :: a
+
+    integer, allocatable :: itemp(:) 
+    integer :: info
+    
+    call a%psb_d_base_sparse_mat%psb_base_sparse_mat%transp()
+    call move_alloc(a%ia,itemp)
+    call move_alloc(a%ja,a%ia)
+    call move_alloc(itemp,a%ja)
+        
+    call a%fix(info)
+
+    return
+    
+  end subroutine d_coo_transp_1mat
+
+  subroutine d_coo_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_d_coo_sparse_mat), intent(inout) :: a
+    
+    call a%transp() 
+  end subroutine d_coo_transc_1mat
+
+  subroutine d_base_transp_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_d_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+
+    type(psb_d_coo_sparse_mat) :: tmp
+    integer err_act, info
+    character(len=*), parameter :: name='d_base_transp'
+    
+    call psb_erractionsave(err_act)
+
+    info = 0
+    select type(b)
+    class is (psb_d_base_sparse_mat)
+      call b%cp_to_coo(tmp,info)
+      if (info == 0) call tmp%transp()
+      if (info == 0) call a%mv_from_coo(tmp,info)
+    class default
+      info = 700
+    end select
+    if (info /= 0) then 
+      call psb_errpush(info,name,a_err=b%get_fmt())
+      goto 9999
+    end if
+    call psb_erractionrestore(err_act) 
+
+    return
+9999 continue
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
+      
+    return
+    
+  end subroutine d_base_transp_2mat
+
+  subroutine d_base_transc_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_d_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+    
+    call a%transp(b) 
+  end subroutine d_base_transc_2mat
+
+  subroutine d_base_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_d_base_sparse_mat), intent(inout) :: a
+
+    type(psb_d_coo_sparse_mat) :: tmp
+    integer :: err_act, info
+    character(len=*), parameter :: name='d_base_transp'
+
+    call psb_erractionsave(err_act)
+    info = 0
+    call a%mv_to_coo(tmp,info)
+    if (info == 0) call tmp%transp()
+    if (info == 0) call a%mv_from_coo(tmp,info)
+    
+    if (info /= 0) then 
+      info = 700 
+      call psb_errpush(info,name,a_err=a%get_fmt())
+      goto 9999
+    end if
+    call psb_erractionrestore(err_act) 
+
+    return
+9999 continue
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
+      
+    return
+    
+    
+  end subroutine d_base_transp_1mat
+
+  subroutine d_base_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_d_base_sparse_mat), intent(inout) :: a
+    
+    call a%transp() 
+  end subroutine d_base_transc_1mat
+
+
+
+
   !====================================
   !
   !

base/modules/psb_d_mat_mod.f03

@@ -64,6 +64,13 @@ module psb_d_mat_mod
     generic, public    :: mv_from => d_mv_from
     procedure, pass(a) :: d_cp_from
     generic, public    :: cp_from => d_cp_from
+    procedure, pass(a) :: d_transp_1mat
+    procedure, pass(a) :: d_transp_2mat
+    generic, public    :: transp => d_transp_1mat, d_transp_2mat
+    procedure, pass(a) :: d_transc_1mat
+    procedure, pass(a) :: d_transc_2mat
+    generic, public    :: transc => d_transc_1mat, d_transc_2mat
+
     
     
     ! Computational routines 
@@ -93,7 +100,9 @@ module psb_d_mat_mod
        & set_upd, set_asb, set_sorted, &
        & set_upper, set_lower, set_triangle, &
        & set_unit, get_diag, get_nz_row, d_csgetptn, &
-       & d_mv_from, d_cp_from
+       & d_mv_from, d_cp_from, &
+       & d_transp_1mat, d_transp_2mat, &
+       & d_transc_1mat, d_transc_2mat
 
   interface psb_sizeof
     module procedure d_sizeof
@@ -1581,6 +1590,154 @@ contains
   end subroutine d_sparse_mat_clone
 
 
+  subroutine d_transp_1mat(a)
+    use psb_error_mod
+    use psb_string_mod
+    implicit none 
+    class(psb_d_sparse_mat), intent(inout) :: a
+
+    Integer :: err_act, info
+    character(len=20)  :: name='transp'
+    logical, parameter :: debug=.false.
+
+
+    call psb_erractionsave(err_act)
+    if (a%is_null()) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+    call a%a%transp()
+
+    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
+
+  end subroutine d_transp_1mat
+
+
+  subroutine d_transp_2mat(a,b)
+    use psb_error_mod
+    use psb_string_mod
+    implicit none 
+    class(psb_d_sparse_mat), intent(out) :: a
+    class(psb_d_sparse_mat), intent(in)  :: b
+
+    Integer :: err_act, info
+    character(len=20)  :: name='transp'
+    logical, parameter :: debug=.false.
+
+
+    call psb_erractionsave(err_act)
+    if (b%is_null()) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+    allocate(a%a,source=b%a,stat=info)
+    if (info /= 0) then 
+      info = 4000
+      goto 9999
+    end if
+    call a%a%transp(b%a)    
+
+    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
+
+  end subroutine d_transp_2mat
+
+  subroutine d_transc_1mat(a)
+    use psb_error_mod
+    use psb_string_mod
+    implicit none 
+    class(psb_d_sparse_mat), intent(inout) :: a
+
+    Integer :: err_act, info
+    character(len=20)  :: name='transc'
+    logical, parameter :: debug=.false.
+
+
+    call psb_erractionsave(err_act)
+    if (a%is_null()) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+    call a%a%transc()
+
+    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
+
+  end subroutine d_transc_1mat
+
+
+  subroutine d_transc_2mat(a,b)
+    use psb_error_mod
+    use psb_string_mod
+    implicit none 
+    class(psb_d_sparse_mat), intent(out) :: a
+    class(psb_d_sparse_mat), intent(in)  :: b
+
+    Integer :: err_act, info
+    character(len=20)  :: name='transc'
+    logical, parameter :: debug=.false.
+
+
+    call psb_erractionsave(err_act)
+    if (b%is_null()) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+    allocate(a%a,source=b%a,stat=info)
+    if (info /= 0) then 
+      info = 4000
+      goto 9999
+    end if
+    call a%a%transc(b%a)    
+    
+    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
+
+  end subroutine d_transc_2mat
+
+
+
   subroutine reinit(a,clear)
     use psb_error_mod
     implicit none 
@@ -1613,6 +1770,7 @@ contains
   end subroutine reinit
 
 
+
   !=====================================
   !
   !