psblas3:

base/modules/psb_c_base_mat_mod.f03
 base/modules/psb_d_base_mat_mod.f03
 base/modules/psb_s_base_mat_mod.f03
 base/modules/psb_z_base_mat_mod.f03
 base/serial/f03/psb_d_csc_impl.f03

Fixes for compilation with GNU 4.5.0 (fortran-dev branch).
Added transpose to S/C/Z.

base/modules/psb_c_base_mat_mod.f03

@@ -36,6 +36,11 @@ module psb_c_base_mat_mod
     generic, public    :: cp_from => c_base_cp_from
     procedure, pass(a) :: c_base_mv_from
     generic, public    :: mv_from => c_base_mv_from
+
+    procedure, pass(a) :: base_transp_1mat => c_base_transp_1mat
+    procedure, pass(a) :: base_transp_2mat => c_base_transp_2mat
+    procedure, pass(a) :: base_transc_1mat => c_base_transc_1mat
+    procedure, pass(a) :: base_transc_2mat => c_base_transc_2mat
   end type psb_c_base_sparse_mat
 
   private :: c_base_csmv, c_base_csmm, c_base_cssv, c_base_cssm,&
@@ -88,6 +93,8 @@ module psb_c_base_mat_mod
     generic, public    :: cp_from => c_coo_cp_from
     procedure, pass(a) :: c_coo_mv_from
     generic, public    :: mv_from => c_coo_mv_from
+    procedure, pass(a) :: base_transp_1mat => c_coo_transp_1mat
+    procedure, pass(a) :: base_transc_1mat => c_coo_transc_1mat
         
   end type psb_c_coo_sparse_mat
 
@@ -99,7 +106,8 @@ module psb_c_base_mat_mod
        & c_cp_coo_to_fmt, c_cp_coo_from_fmt, &
        & c_coo_scals, c_coo_scal, c_coo_csgetrow, c_coo_sizeof, &
        & c_coo_csgetptn, c_coo_get_nz_row, c_coo_reinit,&
-       & c_coo_cp_from, c_coo_mv_from
+       & c_coo_cp_from, c_coo_mv_from, &
+       & c_coo_transp_1mat, c_coo_transc_1mat
 
   
   interface 
@@ -779,6 +787,186 @@ contains
   end subroutine csclip
 
 
+  !
+  ! Here we go. 
+  !
+  subroutine c_coo_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_c_coo_sparse_mat), intent(inout) :: a
+
+    integer, allocatable :: itemp(:) 
+    integer :: info
+    
+    call a%psb_c_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 c_coo_transp_1mat
+
+  subroutine c_coo_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_c_coo_sparse_mat), intent(inout) :: a
+    
+    call a%transp() 
+    a%val(:) = conjg(a%val)
+
+  end subroutine c_coo_transc_1mat
+
+  subroutine c_base_transp_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_c_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+
+    type(psb_c_coo_sparse_mat) :: tmp
+    integer err_act, info
+    character(len=*), parameter :: name='c_base_transp'
+    
+    call psb_erractionsave(err_act)
+
+    info = 0
+    select type(b)
+    class is (psb_c_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 c_base_transp_2mat
+
+  subroutine c_base_transc_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_c_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+
+    type(psb_c_coo_sparse_mat) :: tmp
+    integer err_act, info
+    character(len=*), parameter :: name='c_base_transc'
+    
+    call psb_erractionsave(err_act)
+
+    
+    info = 0
+    select type(b)
+    class is (psb_c_base_sparse_mat)
+      call b%cp_to_coo(tmp,info)
+      if (info == 0) call tmp%transc()
+      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 c_base_transc_2mat
+
+  subroutine c_base_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_c_base_sparse_mat), intent(inout) :: a
+
+    type(psb_c_coo_sparse_mat) :: tmp
+    integer :: err_act, info
+    character(len=*), parameter :: name='c_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 c_base_transp_1mat
+
+  subroutine c_base_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_c_base_sparse_mat), intent(inout) :: a
+    
+    type(psb_c_coo_sparse_mat) :: tmp
+    integer :: err_act, info
+    character(len=*), parameter :: name='c_base_transc'
+
+    call psb_erractionsave(err_act)
+    info = 0
+    call a%mv_to_coo(tmp,info)
+    if (info == 0) call tmp%transc()
+    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 c_base_transc_1mat
+
+
+
 
   !====================================
   !

base/modules/psb_d_base_mat_mod.f03

@@ -790,34 +790,6 @@ 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 

base/modules/psb_s_base_mat_mod.f03

@@ -36,6 +36,11 @@ module psb_s_base_mat_mod
     generic, public    :: cp_from => s_base_cp_from
     procedure, pass(a) :: s_base_mv_from
     generic, public    :: mv_from => s_base_mv_from
+
+    procedure, pass(a) :: base_transp_1mat => s_base_transp_1mat
+    procedure, pass(a) :: base_transp_2mat => s_base_transp_2mat
+    procedure, pass(a) :: base_transc_1mat => s_base_transc_1mat
+    procedure, pass(a) :: base_transc_2mat => s_base_transc_2mat
   end type psb_s_base_sparse_mat
 
   private :: s_base_csmv, s_base_csmm, s_base_cssv, s_base_cssm,&
@@ -88,6 +93,8 @@ module psb_s_base_mat_mod
     generic, public    :: cp_from => s_coo_cp_from
     procedure, pass(a) :: s_coo_mv_from
     generic, public    :: mv_from => s_coo_mv_from
+    procedure, pass(a) :: base_transp_1mat => s_coo_transp_1mat
+    procedure, pass(a) :: base_transc_1mat => s_coo_transc_1mat
     
   end type psb_s_coo_sparse_mat
 
@@ -99,7 +106,9 @@ module psb_s_base_mat_mod
        & s_cp_coo_to_fmt, s_cp_coo_from_fmt, &
        & s_coo_scals, s_coo_scal, s_coo_csgetrow, s_coo_sizeof, &
        & s_coo_csgetptn, s_coo_get_nz_row, s_coo_reinit,&
-       & s_coo_cp_from, s_coo_mv_from
+       & s_coo_cp_from, s_coo_mv_from, &
+       & s_coo_transp_1mat, s_coo_transc_1mat
+
 
   
   interface 
@@ -778,6 +787,127 @@ contains
 
   end subroutine csclip
 
+  subroutine s_coo_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_s_coo_sparse_mat), intent(inout) :: a
+
+    integer, allocatable :: itemp(:) 
+    integer :: info
+    
+    call a%psb_s_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 s_coo_transp_1mat
+
+  subroutine s_coo_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_s_coo_sparse_mat), intent(inout) :: a
+    
+    call a%transp() 
+  end subroutine s_coo_transc_1mat
+
+  subroutine s_base_transp_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_s_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+
+    type(psb_s_coo_sparse_mat) :: tmp
+    integer err_act, info
+    character(len=*), parameter :: name='s_base_transp'
+    
+    call psb_erractionsave(err_act)
+
+    info = 0
+    select type(b)
+    class is (psb_s_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 s_base_transp_2mat
+
+  subroutine s_base_transc_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_s_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+    
+    call a%transp(b) 
+  end subroutine s_base_transc_2mat
+
+  subroutine s_base_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_s_base_sparse_mat), intent(inout) :: a
+
+    type(psb_s_coo_sparse_mat) :: tmp
+    integer :: err_act, info
+    character(len=*), parameter :: name='s_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 s_base_transp_1mat
+
+  subroutine s_base_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_s_base_sparse_mat), intent(inout) :: a
+    
+    call a%transp() 
+  end subroutine s_base_transc_1mat
+
+
 
 
   !====================================

base/modules/psb_z_base_mat_mod.f03

@@ -36,6 +36,11 @@ module psb_z_base_mat_mod
     generic, public    :: cp_from => z_base_cp_from
     procedure, pass(a) :: z_base_mv_from
     generic, public    :: mv_from => z_base_mv_from
+
+    procedure, pass(a) :: base_transp_1mat => z_base_transp_1mat
+    procedure, pass(a) :: base_transp_2mat => z_base_transp_2mat
+    procedure, pass(a) :: base_transc_1mat => z_base_transc_1mat
+    procedure, pass(a) :: base_transc_2mat => z_base_transc_2mat
   end type psb_z_base_sparse_mat
 
   private :: z_base_csmv, z_base_csmm, z_base_cssv, z_base_cssm,&
@@ -88,6 +93,8 @@ module psb_z_base_mat_mod
     generic, public    :: cp_from => z_coo_cp_from
     procedure, pass(a) :: z_coo_mv_from
     generic, public    :: mv_from => z_coo_mv_from
+    procedure, pass(a) :: base_transp_1mat => z_coo_transp_1mat
+    procedure, pass(a) :: base_transc_1mat => z_coo_transc_1mat
     
   end type psb_z_coo_sparse_mat
 
@@ -99,7 +106,8 @@ module psb_z_base_mat_mod
        & z_cp_coo_to_fmt, z_cp_coo_from_fmt, &
        & z_coo_scals, z_coo_scal, z_coo_csgetrow, z_coo_sizeof, &
        & z_coo_csgetptn, z_coo_get_nz_row, z_coo_reinit,&
-       & z_coo_cp_from, z_coo_mv_from
+       & z_coo_cp_from, z_coo_mv_from, &
+       & z_coo_transp_1mat, z_coo_transc_1mat
 
   
   interface 
@@ -779,6 +787,187 @@ contains
   end subroutine csclip
 
 
+  !
+  ! Here we go. 
+  !
+  subroutine z_coo_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_z_coo_sparse_mat), intent(inout) :: a
+
+    integer, allocatable :: itemp(:) 
+    integer :: info
+    
+    call a%psb_z_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 z_coo_transp_1mat
+
+  subroutine z_coo_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_z_coo_sparse_mat), intent(inout) :: a
+    
+    call a%transp() 
+    a%val(:) = conjg(a%val)
+
+  end subroutine z_coo_transc_1mat
+
+  subroutine z_base_transp_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_z_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+
+    type(psb_z_coo_sparse_mat) :: tmp
+    integer err_act, info
+    character(len=*), parameter :: name='z_base_transp'
+    
+    call psb_erractionsave(err_act)
+
+    info = 0
+    select type(b)
+    class is (psb_z_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 z_base_transp_2mat
+
+  subroutine z_base_transc_2mat(a,b)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_z_base_sparse_mat), intent(out) :: a
+    class(psb_base_sparse_mat), intent(in)   :: b
+
+    type(psb_z_coo_sparse_mat) :: tmp
+    integer err_act, info
+    character(len=*), parameter :: name='z_base_transc'
+    
+    call psb_erractionsave(err_act)
+
+    
+    info = 0
+    select type(b)
+    class is (psb_z_base_sparse_mat)
+      call b%cp_to_coo(tmp,info)
+      if (info == 0) call tmp%transc()
+      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 z_base_transc_2mat
+
+  subroutine z_base_transp_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_z_base_sparse_mat), intent(inout) :: a
+
+    type(psb_z_coo_sparse_mat) :: tmp
+    integer :: err_act, info
+    character(len=*), parameter :: name='z_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 z_base_transp_1mat
+
+  subroutine z_base_transc_1mat(a)
+    use psb_error_mod
+    implicit none 
+    
+    class(psb_z_base_sparse_mat), intent(inout) :: a
+    
+    type(psb_z_coo_sparse_mat) :: tmp
+    integer :: err_act, info
+    character(len=*), parameter :: name='z_base_transc'
+
+    call psb_erractionsave(err_act)
+    info = 0
+    call a%mv_to_coo(tmp,info)
+    if (info == 0) call tmp%transc()
+    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 z_base_transc_1mat
+
+
+
+
 
   !====================================
   !

base/serial/f03/psb_d_csc_impl.f03

@@ -1929,7 +1929,10 @@ subroutine d_cp_csc_to_fmt_impl(a,b,info)
     call a%cp_to_coo(b,info)
 
   type is (psb_d_csc_sparse_mat) 
-    b = a
+    call b%psb_d_base_sparse_mat%cp_from(a%psb_d_base_sparse_mat)
+    b%icp = a%icp
+    b%ia  = a%ia
+    b%val = a%val
 
   class default
     call tmp%cp_from_fmt(a,info)