diff --git a/base/serial/f03/psb_c_mat_impl.f03 b/base/serial/f03/psb_c_mat_impl.F03 similarity index 98% rename from base/serial/f03/psb_c_mat_impl.f03 rename to base/serial/f03/psb_c_mat_impl.F03 index 8d78ace6..5ecc8d91 100644 --- a/base/serial/f03/psb_c_mat_impl.f03 +++ b/base/serial/f03/psb_c_mat_impl.F03 @@ -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 diff --git a/base/serial/f03/psb_d_mat_impl.f03 b/base/serial/f03/psb_d_mat_impl.F03 similarity index 98% rename from base/serial/f03/psb_d_mat_impl.f03 rename to base/serial/f03/psb_d_mat_impl.F03 index 0db620dd..b45fc657 100644 --- a/base/serial/f03/psb_d_mat_impl.f03 +++ b/base/serial/f03/psb_d_mat_impl.F03 @@ -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 diff --git a/base/serial/f03/psb_s_mat_impl.f03 b/base/serial/f03/psb_s_mat_impl.F03 similarity index 98% rename from base/serial/f03/psb_s_mat_impl.f03 rename to base/serial/f03/psb_s_mat_impl.F03 index 25b54d35..eaed4ba7 100644 --- a/base/serial/f03/psb_s_mat_impl.f03 +++ b/base/serial/f03/psb_s_mat_impl.F03 @@ -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 diff --git a/base/serial/f03/psb_z_mat_impl.f03 b/base/serial/f03/psb_z_mat_impl.F03 similarity index 98% rename from base/serial/f03/psb_z_mat_impl.f03 rename to base/serial/f03/psb_z_mat_impl.F03 index 21192f26..b5e5fb20 100644 --- a/base/serial/f03/psb_z_mat_impl.f03 +++ b/base/serial/f03/psb_z_mat_impl.F03 @@ -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 diff --git a/prec/psb_d_bjacprec.f03 b/prec/psb_d_bjacprec.f03 index d4f6f5fe..ea3c46fb 100644 --- a/prec/psb_d_bjacprec.f03 +++ b/prec/psb_d_bjacprec.f03 @@ -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