fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge development, take out MOLD.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent e31f320cd8
commit d0cbf23126
6 changed files with 30 additions and 127 deletions
Show Stats Download Patch File Download Diff File

11
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -235,25 +235,16 @@ contains
class(psb_c_vect_type), intent(inout) :: x class(psb_c_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_c_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_c_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_c_get_base_vect_default())
#else
mld = psb_c_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)

11
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -235,25 +235,16 @@ contains
class(psb_d_vect_type), intent(inout) :: x class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in), optional :: mold class(psb_d_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_d_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_d_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_d_get_base_vect_default())
#else
mld = psb_d_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)

11
base/modules/serial/psb_i_vect_mod.F90
Unescape Escape View File

@ -208,25 +208,16 @@ contains
class(psb_i_vect_type), intent(inout) :: x class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_i_get_base_vect_default())
#else
mld = psb_i_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)

102
base/modules/serial/psb_l_vect_mod.F90
Unescape Escape View File

@ -167,24 +167,15 @@ contains
class(psb_l_vect_type), intent(inout) :: x class(psb_l_vect_type), intent(inout) :: x
class(psb_l_base_vect_type), intent(in), optional :: mold class(psb_l_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_l_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_l_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_l_get_base_vect_default())
#else
mld = psb_l_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(invect) if (info == psb_success_) call x%v%bld(invect)
@ -199,23 +190,14 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_l_base_vect_type), pointer :: mld class(psb_l_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_l_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_l_get_base_vect_default())
#else
mld = psb_l_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)
@ -227,25 +209,16 @@ contains
class(psb_l_vect_type), intent(inout) :: x class(psb_l_vect_type), intent(inout) :: x
class(psb_l_base_vect_type), intent(in), optional :: mold class(psb_l_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_l_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_l_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_l_get_base_vect_default())
#else
mld = psb_l_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)
@ -326,6 +299,7 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function l_vect_get_fmt end function l_vect_get_fmt
subroutine l_vect_all(n, x, info, mold) subroutine l_vect_all(n, x, info, mold)
implicit none implicit none
@ -338,11 +312,7 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_l_base_vect_type :: x%v,stat=info) allocate(psb_l_base_vect_type :: x%v,stat=info)
endif endif
@ -486,21 +456,22 @@ contains
class(psb_l_vect_type), intent(inout) :: x class(psb_l_vect_type), intent(inout) :: x
class(psb_l_base_vect_type), intent(in), optional :: mold class(psb_l_base_vect_type), intent(in), optional :: mold
class(psb_l_base_vect_type), allocatable :: tmp class(psb_l_base_vect_type), allocatable :: tmp
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else else
call mold%mold(tmp,info) allocate(tmp,stat=info,mold=psb_l_get_base_vect_default())
#endif
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if end if
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end subroutine l_vect_cnv end subroutine l_vect_cnv
@ -698,19 +669,11 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_l_base_multivect_type), pointer :: mld class(psb_l_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_l_get_base_multivect_default()) allocate(x%v,stat=info, mold=psb_l_get_base_multivect_default())
#else
mld = psb_l_get_base_multivect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(invect) if (info == psb_success_) call x%v%bld(invect)
@ -723,21 +686,12 @@ contains
class(psb_l_multivect_type), intent(out) :: x class(psb_l_multivect_type), intent(out) :: x
class(psb_l_base_multivect_type), intent(in), optional :: mold class(psb_l_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_l_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_l_get_base_multivect_default()) allocate(x%v,stat=info, mold=psb_l_get_base_multivect_default())
#else
mld = psb_l_get_base_multivect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(m,n) if (info == psb_success_) call x%v%bld(m,n)
@ -834,11 +788,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_l_base_multivect_type :: x%v,stat=info) allocate(psb_l_base_multivect_type :: x%v,stat=info)
endif endif
@ -997,18 +947,16 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else else
call mold%mold(tmp,info) allocate(tmp,stat=info, mold=psb_l_get_base_multivect_default())
#endif endif
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v) if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info) call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if end if
call move_alloc(tmp,x%v)
end subroutine l_vect_cnv end subroutine l_vect_cnv

11
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -235,25 +235,16 @@ contains
class(psb_s_vect_type), intent(inout) :: x class(psb_s_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_s_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_s_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_s_get_base_vect_default())
#else
mld = psb_s_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)

11
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -235,25 +235,16 @@ contains
class(psb_z_vect_type), intent(inout) :: x class(psb_z_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_z_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_z_get_base_vect_default()) allocate(x%v,stat=info, mold=psb_z_get_base_vect_default())
#else
mld = psb_z_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)

Write Preview
Loading…
Cancel
Save