stopcriterion
			
			
		
Salvatore Filippone 16 years ago
parent d7ca2e084e
commit 48101812b3

@ -1,6 +1,8 @@
Changelog. A lot less detailed than usual, at least for past Changelog. A lot less detailed than usual, at least for past
history. history.
2009/01/27: Changed names from mld_transfer to mld_move_alloc.
2009/01/13: Repackaged the one-level preconditioners. Reorganized the 2009/01/13: Repackaged the one-level preconditioners. Reorganized the
build routines, taking out mlprec_bld, and switching the build routines, taking out mlprec_bld, and switching the
number of levels when needed. number of levels when needed.

@ -6,7 +6,7 @@ HERE=.
FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLIBDIR) FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLIBDIR)
MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o mld_transfer_mod.o MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o mld_move_alloc_mod.o
MPFOBJS=mld_saggrmat_raw_asb.o mld_saggrmat_smth_asb.o \ MPFOBJS=mld_saggrmat_raw_asb.o mld_saggrmat_smth_asb.o \
mld_daggrmat_raw_asb.o mld_daggrmat_smth_asb.o \ mld_daggrmat_raw_asb.o mld_daggrmat_smth_asb.o \
mld_caggrmat_raw_asb.o mld_caggrmat_smth_asb.o \ mld_caggrmat_raw_asb.o mld_caggrmat_smth_asb.o \
@ -58,7 +58,7 @@ COBJS= mld_sslu_interface.o mld_sumf_interface.o \
OBJS=$(F90OBJS) $(COBJS) $(MPFOBJS) $(MPCOBJS) $(MODOBJS) OBJS=$(F90OBJS) $(COBJS) $(MPFOBJS) $(MPCOBJS) $(MODOBJS)
LIBMOD=mld_prec_mod$(.mod) LIBMOD=mld_prec_mod$(.mod)
LOCAL_MODS=$(LIBMOD) mld_prec_type$(.mod) mld_inner_mod$(.mod) mld_transfer_mod$(.mod) LOCAL_MODS=$(LIBMOD) mld_prec_type$(.mod) mld_inner_mod$(.mod) mld_move_alloc_mod$(.mod)
LIBNAME=libmld_prec.a LIBNAME=libmld_prec.a
lib: mpobjs $(OBJS) lib: mpobjs $(OBJS)
@ -69,8 +69,8 @@ lib: mpobjs $(OBJS)
$(F90OBJS) $(MPFOBJS): $(MODOBJS:.o=$(.mod)) $(F90OBJS) $(MPFOBJS): $(MODOBJS:.o=$(.mod))
mld_prec_mod.o mld_innner_mod.o: mld_prec_type.o mld_prec_mod.o mld_innner_mod.o: mld_prec_type.o
mld_inner_mod.o: mld_transfer_mod.o mld_inner_mod.o: mld_move_alloc_mod.o
mld_transfer_mod.o: mld_prec_type.o mld_move_alloc_mod.o: mld_prec_type.o
$(MODOBJS): $(PSBLIBDIR)/psb_base_mod$(.mod) $(MODOBJS): $(PSBLIBDIR)/psb_base_mod$(.mod)

@ -251,13 +251,13 @@ subroutine mld_cprecbld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info) call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
end do end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv do i=newsz+1, iszv
call mld_precfree(p%precv(i),info) call mld_precfree(p%precv(i),info)
end do end do
call mld_transfer(t_prec,p,info) call mld_move_alloc(t_prec,p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = 0 info = 0
! !

@ -251,13 +251,13 @@ subroutine mld_dprecbld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info) call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
end do end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv do i=newsz+1, iszv
call mld_precfree(p%precv(i),info) call mld_precfree(p%precv(i),info)
end do end do
call mld_transfer(t_prec,p,info) call mld_move_alloc(t_prec,p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = 0 info = 0
! !

@ -38,7 +38,7 @@
!!$ !!$
module mld_inner_mod module mld_inner_mod
use mld_prec_type use mld_prec_type
use mld_transfer_mod use mld_move_alloc_mod
interface mld_baseprec_aply interface mld_baseprec_aply
subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)

@ -251,13 +251,13 @@ subroutine mld_sprecbld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info) call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
end do end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv do i=newsz+1, iszv
call mld_precfree(p%precv(i),info) call mld_precfree(p%precv(i),info)
end do end do
call mld_transfer(t_prec,p,info) call mld_move_alloc(t_prec,p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = 0 info = 0
! !

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! File: mld_transfer_mod.f90 ! File: mld_move_alloc_mod.f90
! !
! Package: mld_prec_type ! Package: mld_prec_type
! Data structure(s) for sparse matrices ! Data structure(s) for sparse matrices
@ -56,25 +56,25 @@
! description of the preconditioner, and deallocate its data structure. ! description of the preconditioner, and deallocate its data structure.
! !
module mld_transfer_mod module mld_move_alloc_mod
use mld_prec_type use mld_prec_type
interface mld_transfer interface mld_move_alloc
module procedure mld_sbaseprec_transfer, mld_sonelev_prec_transfer,& module procedure mld_sbaseprec_move_alloc, mld_sonelev_prec_move_alloc,&
& mld_sprec_transfer,& & mld_sprec_move_alloc,&
& mld_dbaseprec_transfer, mld_donelev_prec_transfer,& & mld_dbaseprec_move_alloc, mld_donelev_prec_move_alloc,&
& mld_dprec_transfer,& & mld_dprec_move_alloc,&
& mld_cbaseprec_transfer, mld_conelev_prec_transfer,& & mld_cbaseprec_move_alloc, mld_conelev_prec_move_alloc,&
& mld_cprec_transfer,& & mld_cprec_move_alloc,&
& mld_zbaseprec_transfer, mld_zonelev_prec_transfer,& & mld_zbaseprec_move_alloc, mld_zonelev_prec_move_alloc,&
& mld_zprec_transfer & mld_zprec_move_alloc
end interface end interface
contains contains
subroutine mld_sbaseprec_transfer(a, b,info) subroutine mld_sbaseprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_sbaseprc_type), intent(inout) :: a, b type(mld_sbaseprc_type), intent(inout) :: a, b
@ -82,12 +82,12 @@ contains
integer :: i, isz integer :: i, isz
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%desc_data,b%desc_data,info) if (info == 0) call psb_move_alloc(a%desc_data,b%desc_data,info)
if (info == 0) call psb_transfer(a%perm,b%perm,info) if (info == 0) call psb_move_alloc(a%perm,b%perm,info)
if (info == 0) call psb_transfer(a%invperm,b%invperm,info) if (info == 0) call psb_move_alloc(a%invperm,b%invperm,info)
if (info == 0) call psb_transfer(a%d,b%d,info) if (info == 0) call psb_move_alloc(a%d,b%d,info)
#ifdef HAVE_MOVE_ALLOC #ifdef HAVE_MOVE_ALLOC
call move_alloc(a%av,b%av) call move_alloc(a%av,b%av)
#else #else
@ -95,7 +95,7 @@ contains
isz = size(a%av) isz = size(a%av)
allocate(b%av(isz),stat=info) allocate(b%av(isz),stat=info)
do i=1,isz do i=1,isz
if (info == 0) call psb_transfer(a%av(i), b%av(i), info) if (info == 0) call psb_move_alloc(a%av(i), b%av(i), info)
end do end do
if (info == 0) deallocate(a%av,stat=info) if (info == 0) deallocate(a%av,stat=info)
@ -105,29 +105,29 @@ contains
write(0,*) 'Error in baseprec_:transfer',info write(0,*) 'Error in baseprec_:transfer',info
end if end if
end subroutine mld_sbaseprec_transfer end subroutine mld_sbaseprec_move_alloc
subroutine mld_sonelev_prec_transfer(a, b,info) subroutine mld_sonelev_prec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_s_interlev_prec_type), intent(inout) :: a, b type(mld_s_interlev_prec_type), intent(inout) :: a, b
integer, intent(out) :: info integer, intent(out) :: info
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call mld_transfer(a%prec,b%prec,info) if (info == 0) call mld_move_alloc(a%prec,b%prec,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%ac,b%ac,info) if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_transfer(a%desc_ac,b%desc_ac,info) if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_transfer(a%mlia,b%mlia,info) if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_transfer(a%nlaggr,b%nlaggr,info) if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_transfer(a%map,b%map,info) if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a b%base_a => a%base_a
b%base_desc => a%base_desc b%base_desc => a%base_desc
end subroutine mld_sonelev_prec_transfer end subroutine mld_sonelev_prec_move_alloc
subroutine mld_sprec_transfer(a, b,info) subroutine mld_sprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_sprec_type), intent(inout) :: a type(mld_sprec_type), intent(inout) :: a
@ -151,11 +151,11 @@ contains
isz = size(a%precv) isz = size(a%precv)
allocate(b%precv(isz),stat=info) allocate(b%precv(isz),stat=info)
if (info /= 0) then if (info /= 0) then
write(0,*) 'Memory allocation failure in prec_transfer' write(0,*) 'Memory allocation failure in prec_move_alloc'
return return
end if end if
do i=1,isz do i=1,isz
call mld_transfer(a%precv(i),b%precv(i),info) call mld_move_alloc(a%precv(i),b%precv(i),info)
end do end do
deallocate(a%precv,stat=info) deallocate(a%precv,stat=info)
#endif #endif
@ -166,10 +166,10 @@ contains
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
end do end do
end subroutine mld_sprec_transfer end subroutine mld_sprec_move_alloc
subroutine mld_dbaseprec_transfer(a, b,info) subroutine mld_dbaseprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_dbaseprc_type), intent(inout) :: a, b type(mld_dbaseprc_type), intent(inout) :: a, b
@ -177,12 +177,12 @@ contains
integer :: i, isz integer :: i, isz
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%desc_data,b%desc_data,info) if (info == 0) call psb_move_alloc(a%desc_data,b%desc_data,info)
if (info == 0) call psb_transfer(a%perm,b%perm,info) if (info == 0) call psb_move_alloc(a%perm,b%perm,info)
if (info == 0) call psb_transfer(a%invperm,b%invperm,info) if (info == 0) call psb_move_alloc(a%invperm,b%invperm,info)
if (info == 0) call psb_transfer(a%d,b%d,info) if (info == 0) call psb_move_alloc(a%d,b%d,info)
#ifdef HAVE_MOVE_ALLOC #ifdef HAVE_MOVE_ALLOC
call move_alloc(a%av,b%av) call move_alloc(a%av,b%av)
#else #else
@ -190,7 +190,7 @@ contains
isz = size(a%av) isz = size(a%av)
allocate(b%av(isz),stat=info) allocate(b%av(isz),stat=info)
do i=1,isz do i=1,isz
if (info == 0) call psb_transfer(a%av(i), b%av(i), info) if (info == 0) call psb_move_alloc(a%av(i), b%av(i), info)
end do end do
if (info == 0) deallocate(a%av,stat=info) if (info == 0) deallocate(a%av,stat=info)
@ -200,29 +200,29 @@ contains
write(0,*) 'Error in baseprec_:transfer',info write(0,*) 'Error in baseprec_:transfer',info
end if end if
end subroutine mld_dbaseprec_transfer end subroutine mld_dbaseprec_move_alloc
subroutine mld_donelev_prec_transfer(a, b,info) subroutine mld_donelev_prec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_d_interlev_prec_type), intent(inout) :: a, b type(mld_d_interlev_prec_type), intent(inout) :: a, b
integer, intent(out) :: info integer, intent(out) :: info
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call mld_transfer(a%prec,b%prec,info) if (info == 0) call mld_move_alloc(a%prec,b%prec,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%ac,b%ac,info) if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_transfer(a%desc_ac,b%desc_ac,info) if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_transfer(a%mlia,b%mlia,info) if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_transfer(a%nlaggr,b%nlaggr,info) if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_transfer(a%map,b%map,info) if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a b%base_a => a%base_a
b%base_desc => a%base_desc b%base_desc => a%base_desc
end subroutine mld_donelev_prec_transfer end subroutine mld_donelev_prec_move_alloc
subroutine mld_dprec_transfer(a, b,info) subroutine mld_dprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_dprec_type), intent(inout) :: a type(mld_dprec_type), intent(inout) :: a
@ -246,11 +246,11 @@ contains
isz = size(a%precv) isz = size(a%precv)
allocate(b%precv(isz),stat=info) allocate(b%precv(isz),stat=info)
if (info /= 0) then if (info /= 0) then
write(0,*) 'Memory allocation failure in prec_transfer' write(0,*) 'Memory allocation failure in prec_move_alloc'
return return
end if end if
do i=1,isz do i=1,isz
call mld_transfer(a%precv(i),b%precv(i),info) call mld_move_alloc(a%precv(i),b%precv(i),info)
end do end do
deallocate(a%precv,stat=info) deallocate(a%precv,stat=info)
#endif #endif
@ -261,10 +261,10 @@ contains
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
end do end do
end subroutine mld_dprec_transfer end subroutine mld_dprec_move_alloc
subroutine mld_cbaseprec_transfer(a, b,info) subroutine mld_cbaseprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_cbaseprc_type), intent(inout) :: a, b type(mld_cbaseprc_type), intent(inout) :: a, b
@ -272,12 +272,12 @@ contains
integer :: i, isz integer :: i, isz
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%desc_data,b%desc_data,info) if (info == 0) call psb_move_alloc(a%desc_data,b%desc_data,info)
if (info == 0) call psb_transfer(a%perm,b%perm,info) if (info == 0) call psb_move_alloc(a%perm,b%perm,info)
if (info == 0) call psb_transfer(a%invperm,b%invperm,info) if (info == 0) call psb_move_alloc(a%invperm,b%invperm,info)
if (info == 0) call psb_transfer(a%d,b%d,info) if (info == 0) call psb_move_alloc(a%d,b%d,info)
#ifdef HAVE_MOVE_ALLOC #ifdef HAVE_MOVE_ALLOC
call move_alloc(a%av,b%av) call move_alloc(a%av,b%av)
#else #else
@ -285,7 +285,7 @@ contains
isz = size(a%av) isz = size(a%av)
allocate(b%av(isz),stat=info) allocate(b%av(isz),stat=info)
do i=1,isz do i=1,isz
if (info == 0) call psb_transfer(a%av(i), b%av(i), info) if (info == 0) call psb_move_alloc(a%av(i), b%av(i), info)
end do end do
if (info == 0) deallocate(a%av,stat=info) if (info == 0) deallocate(a%av,stat=info)
@ -295,29 +295,29 @@ contains
write(0,*) 'Error in baseprec_:transfer',info write(0,*) 'Error in baseprec_:transfer',info
end if end if
end subroutine mld_cbaseprec_transfer end subroutine mld_cbaseprec_move_alloc
subroutine mld_conelev_prec_transfer(a, b,info) subroutine mld_conelev_prec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_c_interlev_prec_type), intent(inout) :: a, b type(mld_c_interlev_prec_type), intent(inout) :: a, b
integer, intent(out) :: info integer, intent(out) :: info
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call mld_transfer(a%prec,b%prec,info) if (info == 0) call mld_move_alloc(a%prec,b%prec,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%ac,b%ac,info) if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_transfer(a%desc_ac,b%desc_ac,info) if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_transfer(a%mlia,b%mlia,info) if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_transfer(a%nlaggr,b%nlaggr,info) if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_transfer(a%map,b%map,info) if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a b%base_a => a%base_a
b%base_desc => a%base_desc b%base_desc => a%base_desc
end subroutine mld_conelev_prec_transfer end subroutine mld_conelev_prec_move_alloc
subroutine mld_cprec_transfer(a, b,info) subroutine mld_cprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_cprec_type), intent(inout) :: a type(mld_cprec_type), intent(inout) :: a
@ -341,11 +341,11 @@ contains
isz = size(a%precv) isz = size(a%precv)
allocate(b%precv(isz),stat=info) allocate(b%precv(isz),stat=info)
if (info /= 0) then if (info /= 0) then
write(0,*) 'Memory allocation failure in prec_transfer' write(0,*) 'Memory allocation failure in prec_move_alloc'
return return
end if end if
do i=1,isz do i=1,isz
call mld_transfer(a%precv(i),b%precv(i),info) call mld_move_alloc(a%precv(i),b%precv(i),info)
end do end do
deallocate(a%precv,stat=info) deallocate(a%precv,stat=info)
#endif #endif
@ -356,10 +356,10 @@ contains
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
end do end do
end subroutine mld_cprec_transfer end subroutine mld_cprec_move_alloc
subroutine mld_zbaseprec_transfer(a, b,info) subroutine mld_zbaseprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_zbaseprc_type), intent(inout) :: a, b type(mld_zbaseprc_type), intent(inout) :: a, b
@ -367,12 +367,12 @@ contains
integer :: i, isz integer :: i, isz
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%desc_data,b%desc_data,info) if (info == 0) call psb_move_alloc(a%desc_data,b%desc_data,info)
if (info == 0) call psb_transfer(a%perm,b%perm,info) if (info == 0) call psb_move_alloc(a%perm,b%perm,info)
if (info == 0) call psb_transfer(a%invperm,b%invperm,info) if (info == 0) call psb_move_alloc(a%invperm,b%invperm,info)
if (info == 0) call psb_transfer(a%d,b%d,info) if (info == 0) call psb_move_alloc(a%d,b%d,info)
#ifdef HAVE_MOVE_ALLOC #ifdef HAVE_MOVE_ALLOC
call move_alloc(a%av,b%av) call move_alloc(a%av,b%av)
#else #else
@ -380,7 +380,7 @@ contains
isz = size(a%av) isz = size(a%av)
allocate(b%av(isz),stat=info) allocate(b%av(isz),stat=info)
do i=1,isz do i=1,isz
if (info == 0) call psb_transfer(a%av(i), b%av(i), info) if (info == 0) call psb_move_alloc(a%av(i), b%av(i), info)
end do end do
if (info == 0) deallocate(a%av,stat=info) if (info == 0) deallocate(a%av,stat=info)
@ -390,29 +390,29 @@ contains
write(0,*) 'Error in baseprec_:transfer',info write(0,*) 'Error in baseprec_:transfer',info
end if end if
end subroutine mld_zbaseprec_transfer end subroutine mld_zbaseprec_move_alloc
subroutine mld_zonelev_prec_transfer(a, b,info) subroutine mld_zonelev_prec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_z_interlev_prec_type), intent(inout) :: a, b type(mld_z_interlev_prec_type), intent(inout) :: a, b
integer, intent(out) :: info integer, intent(out) :: info
call mld_precfree(b,info) call mld_precfree(b,info)
if (info == 0) call mld_transfer(a%prec,b%prec,info) if (info == 0) call mld_move_alloc(a%prec,b%prec,info)
if (info == 0) call psb_transfer(a%iprcparm,b%iprcparm,info) if (info == 0) call psb_move_alloc(a%iprcparm,b%iprcparm,info)
if (info == 0) call psb_transfer(a%rprcparm,b%rprcparm,info) if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_transfer(a%ac,b%ac,info) if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_transfer(a%desc_ac,b%desc_ac,info) if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_transfer(a%mlia,b%mlia,info) if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_transfer(a%nlaggr,b%nlaggr,info) if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_transfer(a%map,b%map,info) if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a b%base_a => a%base_a
b%base_desc => a%base_desc b%base_desc => a%base_desc
end subroutine mld_zonelev_prec_transfer end subroutine mld_zonelev_prec_move_alloc
subroutine mld_zprec_transfer(a, b,info) subroutine mld_zprec_move_alloc(a, b,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_zprec_type), intent(inout) :: a type(mld_zprec_type), intent(inout) :: a
@ -436,11 +436,11 @@ contains
isz = size(a%precv) isz = size(a%precv)
allocate(b%precv(isz),stat=info) allocate(b%precv(isz),stat=info)
if (info /= 0) then if (info /= 0) then
write(0,*) 'Memory allocation failure in prec_transfer' write(0,*) 'Memory allocation failure in prec_move_alloc'
return return
end if end if
do i=1,isz do i=1,isz
call mld_transfer(a%precv(i),b%precv(i),info) call mld_move_alloc(a%precv(i),b%precv(i),info)
end do end do
deallocate(a%precv,stat=info) deallocate(a%precv,stat=info)
#endif #endif
@ -451,7 +451,7 @@ contains
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
end do end do
end subroutine mld_zprec_transfer end subroutine mld_zprec_move_alloc
end module mld_transfer_mod end module mld_move_alloc_mod

@ -251,13 +251,13 @@ subroutine mld_zprecbld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info) call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
end do end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv do i=newsz+1, iszv
call mld_precfree(p%precv(i),info) call mld_precfree(p%precv(i),info)
end do end do
call mld_transfer(t_prec,p,info) call mld_move_alloc(t_prec,p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = 0 info = 0
! !

Loading…
Cancel
Save