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

Take out HAVE_MOLD.

Browse Source 
Make support for MOLD mandatory in compiler version.
Define set_vect_defaults() and set_mat_defaults(), invoke them at
_init() time.
This commit is contained in:
Salvatore Filippone
2018-04-05 12:30:28 +01:00
parent 3d347d31dc
commit e37b43d45a
18 changed files with 278 additions and 725 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/impl/psb_c_base_mat_impl.F90
+1 -12
View File
@@ -942,6 +942,7 @@ subroutine psb_c_base_clone(a,b,info)
class(psb_c_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
@@ -953,12 +954,8 @@ subroutine psb_c_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_c_base_clone
@@ -1954,11 +1951,7 @@ subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(cone,d%v(1:nac),x,czero,info)
if (info == psb_success_)&
@@ -1983,11 +1976,7 @@ subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)&
& call a%inner_spsm(alpha,x,czero,tmpv,info,trans)
base/serial/impl/psb_c_mat_impl.F90
+1 -40
View File
@@ -1133,7 +1133,6 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_c_base_sparse_mat), allocatable :: altmp
class(psb_c_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv'
logical, parameter :: debug=.false.
@@ -1155,11 +1154,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1176,12 +1171,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1238,7 +1228,6 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
class(psb_c_base_sparse_mat), allocatable :: altmp
class(psb_c_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false.
@@ -1266,11 +1255,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1287,12 +1272,7 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1507,11 +1487,7 @@ subroutine psb_c_mv_from(a,b)
integer(psb_ipk_) :: info
call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
@@ -1539,11 +1515,7 @@ subroutine psb_c_cp_from(a,b)
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,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
@@ -1592,11 +1564,8 @@ subroutine psb_c_mold(a,b)
class(psb_cspmat_type), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_c_mold
@@ -1706,11 +1675,7 @@ subroutine psb_c_transp_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1781,11 +1746,7 @@ subroutine psb_c_transc_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
base/serial/impl/psb_d_base_mat_impl.F90
+1 -12
View File
@@ -942,6 +942,7 @@ subroutine psb_d_base_clone(a,b,info)
class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
@@ -953,12 +954,8 @@ subroutine psb_d_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_d_base_clone
@@ -1954,11 +1951,7 @@ subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(done,d%v(1:nac),x,dzero,info)
if (info == psb_success_)&
@@ -1983,11 +1976,7 @@ subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)&
& call a%inner_spsm(alpha,x,dzero,tmpv,info,trans)
base/serial/impl/psb_d_mat_impl.F90
+1 -40
View File
@@ -1133,7 +1133,6 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_d_base_sparse_mat), allocatable :: altmp
class(psb_d_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv'
logical, parameter :: debug=.false.
@@ -1155,11 +1154,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1176,12 +1171,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1238,7 +1228,6 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
class(psb_d_base_sparse_mat), allocatable :: altmp
class(psb_d_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false.
@@ -1266,11 +1255,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1287,12 +1272,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1507,11 +1487,7 @@ subroutine psb_d_mv_from(a,b)
integer(psb_ipk_) :: info
call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
@@ -1539,11 +1515,7 @@ subroutine psb_d_cp_from(a,b)
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,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
@@ -1592,11 +1564,8 @@ subroutine psb_d_mold(a,b)
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_d_mold
@@ -1706,11 +1675,7 @@ subroutine psb_d_transp_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1781,11 +1746,7 @@ subroutine psb_d_transc_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
base/serial/impl/psb_s_base_mat_impl.F90
+1 -12
View File
@@ -942,6 +942,7 @@ subroutine psb_s_base_clone(a,b,info)
class(psb_s_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
@@ -953,12 +954,8 @@ subroutine psb_s_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_s_base_clone
@@ -1954,11 +1951,7 @@ subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(sone,d%v(1:nac),x,szero,info)
if (info == psb_success_)&
@@ -1983,11 +1976,7 @@ subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)&
& call a%inner_spsm(alpha,x,szero,tmpv,info,trans)
base/serial/impl/psb_s_mat_impl.F90
+1 -40
View File
@@ -1133,7 +1133,6 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_s_base_sparse_mat), allocatable :: altmp
class(psb_s_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv'
logical, parameter :: debug=.false.
@@ -1155,11 +1154,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1176,12 +1171,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1238,7 +1228,6 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
class(psb_s_base_sparse_mat), allocatable :: altmp
class(psb_s_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false.
@@ -1266,11 +1255,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1287,12 +1272,7 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1507,11 +1487,7 @@ subroutine psb_s_mv_from(a,b)
integer(psb_ipk_) :: info
call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
@@ -1539,11 +1515,7 @@ subroutine psb_s_cp_from(a,b)
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,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
@@ -1592,11 +1564,8 @@ subroutine psb_s_mold(a,b)
class(psb_sspmat_type), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_s_mold
@@ -1706,11 +1675,7 @@ subroutine psb_s_transp_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1781,11 +1746,7 @@ subroutine psb_s_transc_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
base/serial/impl/psb_z_base_mat_impl.F90
+1 -12
View File
@@ -942,6 +942,7 @@ subroutine psb_z_base_clone(a,b,info)
class(psb_z_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
@@ -953,12 +954,8 @@ subroutine psb_z_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_z_base_clone
@@ -1954,11 +1951,7 @@ subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(zone,d%v(1:nac),x,zzero,info)
if (info == psb_success_)&
@@ -1983,11 +1976,7 @@ subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)&
& call a%inner_spsm(alpha,x,zzero,tmpv,info,trans)
base/serial/impl/psb_z_mat_impl.F90
+1 -40
View File
@@ -1133,7 +1133,6 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_z_base_sparse_mat), allocatable :: altmp
class(psb_z_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv'
logical, parameter :: debug=.false.
@@ -1155,11 +1154,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1176,12 +1171,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1238,7 +1228,6 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
class(psb_z_base_sparse_mat), allocatable :: altmp
class(psb_z_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false.
@@ -1266,11 +1255,7 @@ 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
call mold%mold(altmp,info)
#endif
else if (present(type)) then
@@ -1287,12 +1272,7 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end select
else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if
if (info /= psb_success_) then
@@ -1507,11 +1487,7 @@ subroutine psb_z_mv_from(a,b)
integer(psb_ipk_) :: info
call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info)
call b%free()
@@ -1539,11 +1515,7 @@ subroutine psb_z_cp_from(a,b)
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,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
@@ -1592,11 +1564,8 @@ subroutine psb_z_mold(a,b)
class(psb_zspmat_type), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_z_mold
@@ -1706,11 +1675,7 @@ subroutine psb_z_transp_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999
@@ -1781,11 +1746,7 @@ subroutine psb_z_transc_2mat(a,b)
goto 9999
endif
call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
goto 9999