fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/serial/f03/psb_c_mat_impl.F03
 base/serial/f03/psb_c_mat_impl.f03
 base/serial/f03/psb_d_mat_impl.F03
 base/serial/f03/psb_d_mat_impl.f03
 base/serial/f03/psb_s_mat_impl.F03
 base/serial/f03/psb_s_mat_impl.f03
 base/serial/f03/psb_z_mat_impl.F03
 base/serial/f03/psb_z_mat_impl.f03
 prec/psb_d_bjacprec.f03

Added IFDEFs on MOLD= in the implementation of the outer matrix
methods.
This commit is contained in:
Salvatore Filippone
2010-08-31 14:17:28 +00:00
parent f41fb0adbd
commit 0ece9784e4
5 changed files with 119 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/f03/psb_c_mat_impl.f03 → base/serial/f03/psb_c_mat_impl.F03
+29
View File
@@ -995,7 +995,11 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1091,7 +1095,11 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1334,8 +1342,13 @@ subroutine psb_c_mv_from(a,b)
class(psb_c_base_sparse_mat), intent(inout) :: b
integer :: info
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
allocate(a%a,source=b, stat=info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
return
end subroutine psb_c_mv_from
@@ -1355,7 +1368,11 @@ subroutine psb_c_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
allocate(a%a,source=b,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999
@@ -1440,7 +1457,11 @@ subroutine psb_c_sparse_mat_clone(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
allocate(b%a,source=a%a,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999
@@ -1516,7 +1537,11 @@ subroutine psb_c_transp_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1593,7 +1618,11 @@ subroutine psb_c_transc_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
base/serial/f03/psb_d_mat_impl.f03 → base/serial/f03/psb_d_mat_impl.F03
+31 -7
View File
@@ -995,7 +995,11 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1091,7 +1095,11 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1119,13 +1127,8 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
!!$ select type(aa=>altmp)
!!$ type is (psb_d_csr_sparse_mat)
!!$ write(psb_err_unit,*) 'From ALTMP allocation: aa%irp ',allocated(aa%irp),&
!!$ & ' aa%ja ', allocated(aa%ja),&
!!$ & ' aa%val ', allocated(aa%val)
!!$ end select
call altmp%cp_from_fmt(a%a, info)
call altmp%mv_from_fmt(a%a, info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
@@ -1339,8 +1342,13 @@ subroutine psb_d_mv_from(a,b)
class(psb_d_base_sparse_mat), intent(inout) :: b
integer :: info
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
allocate(a%a,source=b, stat=info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
return
end subroutine psb_d_mv_from
@@ -1360,7 +1368,11 @@ subroutine psb_d_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
allocate(a%a,source=b,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999
@@ -1445,7 +1457,11 @@ subroutine psb_d_sparse_mat_clone(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
allocate(b%a,source=a%a,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999
@@ -1521,7 +1537,11 @@ subroutine psb_d_transp_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1598,7 +1618,11 @@ subroutine psb_d_transc_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
base/serial/f03/psb_s_mat_impl.f03 → base/serial/f03/psb_s_mat_impl.F03
+29 -1
View File
@@ -619,7 +619,6 @@ subroutine psb_s_free(a)
implicit none
class(psb_s_sparse_mat), intent(inout) :: a
write(psb_out_unit,*) 'On entry to PSB_S_FREE: ',allocated(a%a)
if (allocated(a%a)) then
call a%a%free()
deallocate(a%a)
@@ -996,7 +995,11 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1092,7 +1095,11 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1335,8 +1342,13 @@ subroutine psb_s_mv_from(a,b)
class(psb_s_base_sparse_mat), intent(inout) :: b
integer :: info
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
allocate(a%a,source=b, stat=info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
return
end subroutine psb_s_mv_from
@@ -1356,7 +1368,11 @@ subroutine psb_s_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
allocate(a%a,source=b,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999
@@ -1441,7 +1457,11 @@ subroutine psb_s_sparse_mat_clone(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
allocate(b%a,source=a%a,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999
@@ -1517,7 +1537,11 @@ subroutine psb_s_transp_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1594,7 +1618,11 @@ subroutine psb_s_transc_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
base/serial/f03/psb_z_mat_impl.f03 → base/serial/f03/psb_z_mat_impl.F03
+29
View File
@@ -995,7 +995,11 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1091,7 +1095,11 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info)
#else
allocate(altmp, source=mold,stat=info)
#endif
else if (present(type)) then
@@ -1334,8 +1342,13 @@ subroutine psb_z_mv_from(a,b)
class(psb_z_base_sparse_mat), intent(inout) :: b
integer :: info
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
allocate(a%a,source=b, stat=info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
return
end subroutine psb_z_mv_from
@@ -1355,7 +1368,11 @@ subroutine psb_z_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
allocate(a%a,source=b,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999
@@ -1440,7 +1457,11 @@ subroutine psb_z_sparse_mat_clone(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
allocate(b%a,source=a%a,stat=info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999
@@ -1516,7 +1537,11 @@ subroutine psb_z_transp_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1593,7 +1618,11 @@ subroutine psb_z_transc_2mat(a,b)
goto 9999
endif
#if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info)
#else
allocate(a%a,source=b%a,stat=info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
prec/psb_d_bjacprec.f03
+1 -1
View File
@@ -318,7 +318,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
!!$ call prec%av(psb_l_pr_)%print(30+me)
!!$ call prec%av(psb_u_pr_)%print(40+me)
!!$ do i=1,n_row