fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixes for IPK8

Browse Source
This commit is contained in:
sfilippone
2025-06-01 20:57:09 +02:00
parent 2f4c9dd579
commit b246223597
47 changed files with 377 additions and 349 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/amg_base_prec_type.F90
+8 -4
View File
@@ -621,9 +621,13 @@ contains
subroutine amg_warn_coarse_mat(val,expected)
integer(psb_ipk_) :: val, expected
integer(psb_mpk_) :: mval, mexp
if (val /= expected) then
mval = val
mexp = expected
write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
& amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected)
& amg_get_coarse_mat_name(mval), &
& ' to ',amg_get_coarse_mat_name(mexp)
end if
end subroutine amg_warn_coarse_mat
@@ -1207,7 +1211,7 @@ contains
implicit none
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_ml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root
integer(psb_mpk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%sweeps_pre,root)
call psb_bcast(ctxt,dat%sweeps_post,root)
@@ -1229,7 +1233,7 @@ contains
implicit none
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_sml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root
integer(psb_mpk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root)
@@ -1240,7 +1244,7 @@ contains
implicit none
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_dml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root
integer(psb_mpk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root)
amgprec/amg_d_matchboxp_mod.F90
+3 -2
View File
@@ -879,7 +879,7 @@ contains
nr = tcoo1%get_nrows()
nc = tcoo1%get_ncols()
nz = tcoo1%get_nzeros()
call tcoo2%allocate(nr,nc,int(1.25*nz))
call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
k2 = 0
!
! Build the entries of \^A for matching
@@ -1056,7 +1056,8 @@ contains
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
real(c_double) :: edgelocweight(:)
real(c_double) :: msgpercent(*)
integer(psb_ipk_) :: info, me, np
integer(psb_ipk_) :: info
integer(psb_mpk_) :: me, np
integer(psb_c_mpk_) :: icomm, mrank, mnp
logical, optional :: display_inp
!
amgprec/amg_s_matchboxp_mod.F90
+3 -2
View File
@@ -879,7 +879,7 @@ contains
nr = tcoo1%get_nrows()
nc = tcoo1%get_ncols()
nz = tcoo1%get_nzeros()
call tcoo2%allocate(nr,nc,int(1.25*nz))
call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
k2 = 0
!
! Build the entries of \^A for matching
@@ -1056,7 +1056,8 @@ contains
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
real(c_float) :: edgelocweight(:)
real(c_double) :: msgpercent(*)
integer(psb_ipk_) :: info, me, np
integer(psb_ipk_) :: info
integer(psb_mpk_) :: me, np
integer(psb_c_mpk_) :: icomm, mrank, mnp
logical, optional :: display_inp
!
amgprec/impl/level/amg_c_base_onelev_map_prol.F90
+2 -2
View File
@@ -55,8 +55,8 @@ subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
!!$ write(0,*) 'Remap handling '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_mpk_) :: me, np, rme, rnp
complex(psb_spk_), allocatable :: rsnd(:), rrcv(:)
type(psb_c_vect_type) :: tv
amgprec/impl/level/amg_c_base_onelev_map_rstr.F90
+2 -2
View File
@@ -56,8 +56,8 @@ subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
!!$ write(0,*) 'Remap handling not implemented yet '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_mpk_) :: me, np, rme, rnp
complex(psb_spk_), allocatable :: rsnd(:), rrcv(:)
type(psb_c_vect_type) :: tv
amgprec/impl/level/amg_d_base_onelev_map_prol.F90
+2 -2
View File
@@ -55,8 +55,8 @@ subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
!!$ write(0,*) 'Remap handling '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_mpk_) :: me, np, rme, rnp
real(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
type(psb_d_vect_type) :: tv
amgprec/impl/level/amg_d_base_onelev_map_rstr.F90
+2 -2
View File
@@ -56,8 +56,8 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
!!$ write(0,*) 'Remap handling not implemented yet '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_mpk_) :: me, np, rme, rnp
real(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
type(psb_d_vect_type) :: tv
amgprec/impl/level/amg_s_base_onelev_map_prol.F90
+2 -2
View File
@@ -55,8 +55,8 @@ subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
!!$ write(0,*) 'Remap handling '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_mpk_) :: me, np, rme, rnp
real(psb_spk_), allocatable :: rsnd(:), rrcv(:)
type(psb_s_vect_type) :: tv
amgprec/impl/level/amg_s_base_onelev_map_rstr.F90
+2 -2
View File
@@ -56,8 +56,8 @@ subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
!!$ write(0,*) 'Remap handling not implemented yet '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_mpk_) :: me, np, rme, rnp
real(psb_spk_), allocatable :: rsnd(:), rrcv(:)
type(psb_s_vect_type) :: tv
amgprec/impl/level/amg_z_base_onelev_map_prol.F90
+2 -2
View File
@@ -55,8 +55,8 @@ subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
!!$ write(0,*) 'Remap handling '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
integer(psb_mpk_) :: me, np, rme, rnp
complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
type(psb_z_vect_type) :: tv
amgprec/impl/level/amg_z_base_onelev_map_rstr.F90
+2 -2
View File
@@ -56,8 +56,8 @@ subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
!!$ write(0,*) 'Remap handling not implemented yet '
block
type(psb_ctxt_type) :: ctxt, nctxt
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_ipk_) :: me, np, rme, rnp
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
integer(psb_mpk_) :: me, np, rme, rnp
complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
type(psb_z_vect_type) :: tv
amgprec/impl/smoother/amg_c_jac_smoother_apply_vect.f90
+2 -2
View File
@@ -183,7 +183,7 @@ subroutine amg_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if ( res < sm%tol*resdenum ) then
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
@@ -275,7 +275,7 @@ subroutine amg_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if (res < sm%tol*resdenum ) then
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
amgprec/impl/smoother/amg_d_jac_smoother_apply_vect.f90
+2 -2
View File
@@ -183,7 +183,7 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if ( res < sm%tol*resdenum ) then
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
@@ -275,7 +275,7 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if (res < sm%tol*resdenum ) then
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
amgprec/impl/smoother/amg_s_jac_smoother_apply_vect.f90
+2 -2
View File
@@ -183,7 +183,7 @@ subroutine amg_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if ( res < sm%tol*resdenum ) then
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
@@ -275,7 +275,7 @@ subroutine amg_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if (res < sm%tol*resdenum ) then
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
amgprec/impl/smoother/amg_z_jac_smoother_apply_vect.f90
+2 -2
View File
@@ -183,7 +183,7 @@ subroutine amg_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if ( res < sm%tol*resdenum ) then
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
@@ -275,7 +275,7 @@ subroutine amg_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if
if (res < sm%tol*resdenum ) then
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
exit
end if
end if
amgprec/impl/solver/amg_c_krm_solver_impl.f90
+7 -4
View File
@@ -96,7 +96,8 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
integer(psb_lpk_) :: lnr
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt, l_ctxt
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
@@ -123,7 +124,7 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
sv%a => a
else
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
n_row = desc_a%get_local_rows()
lnr = n_row
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
@@ -186,7 +187,8 @@ subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_c_vect_type),intent(inout), optional :: initu
type(psb_c_vect_type) :: z
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
@@ -247,7 +249,8 @@ subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
character, intent(in), optional :: init
complex(psb_spk_),intent(inout), optional :: initu(:)
complex(psb_spk_), allocatable :: z(:)
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
amgprec/impl/solver/amg_d_krm_solver_impl.f90
+7 -4
View File
@@ -96,7 +96,8 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
integer(psb_lpk_) :: lnr
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt, l_ctxt
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
@@ -123,7 +124,7 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
sv%a => a
else
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
n_row = desc_a%get_local_rows()
lnr = n_row
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
@@ -186,7 +187,8 @@ subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_d_vect_type),intent(inout), optional :: initu
type(psb_d_vect_type) :: z
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
@@ -247,7 +249,8 @@ subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
character, intent(in), optional :: init
real(psb_dpk_),intent(inout), optional :: initu(:)
real(psb_dpk_), allocatable :: z(:)
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
amgprec/impl/solver/amg_s_krm_solver_impl.f90
+7 -4
View File
@@ -96,7 +96,8 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
integer(psb_lpk_) :: lnr
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt, l_ctxt
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
@@ -123,7 +124,7 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
sv%a => a
else
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
n_row = desc_a%get_local_rows()
lnr = n_row
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
@@ -186,7 +187,8 @@ subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_s_vect_type),intent(inout), optional :: initu
type(psb_s_vect_type) :: z
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
@@ -247,7 +249,8 @@ subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
character, intent(in), optional :: init
real(psb_spk_),intent(inout), optional :: initu(:)
real(psb_spk_), allocatable :: z(:)
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
amgprec/impl/solver/amg_z_krm_solver_impl.f90
+7 -4
View File
@@ -96,7 +96,8 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
integer(psb_lpk_) :: lnr
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt, l_ctxt
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
@@ -123,7 +124,7 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
sv%a => a
else
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
n_row = desc_a%get_local_rows()
lnr = n_row
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
@@ -186,7 +187,8 @@ subroutine amg_z_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_z_vect_type),intent(inout), optional :: initu
type(psb_z_vect_type) :: z
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
@@ -247,7 +249,8 @@ subroutine amg_z_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
character, intent(in), optional :: init
complex(psb_dpk_),intent(inout), optional :: initu(:)
complex(psb_dpk_), allocatable :: z(:)
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
integer(psb_mpk_) :: np,me
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
cbind/amgprec/amg_c_dprec.c
+1 -1
View File
@@ -11,7 +11,7 @@ amg_c_dprec* amg_c_dprec_new()
}
int amg_c_dprec_delete(amg_c_dprec* p)
psb_i_t amg_c_dprec_delete(amg_c_dprec* p)
{
int iret;
iret=amg_c_dprecfree(p);
cbind/amgprec/amg_c_zprec.c
+1 -1
View File
@@ -11,7 +11,7 @@ amg_c_dprec* amg_c_new_dprec()
}
int amg_c_delete_dprec(amg_c_dprec* p)
psb_i_t amg_c_delete_dprec(amg_c_dprec* p)
{
int iret;
iret=amg_c_dprecfree(p);
cbind/amgprec/amg_dprec_cbind_mod.F90
+9 -9
View File
@@ -31,7 +31,7 @@ contains
type(amg_c_dprec) :: ph
type(psb_c_object_type), value :: cctxt
character(c_char) :: ptype(*)
integer :: info
integer(psb_ipk_) :: info
type(amg_dprec_type), pointer :: precp
character(len=80) :: fptype
@@ -64,7 +64,7 @@ contains
type(psb_c_object_type) :: ph
character(c_char) :: what(*)
integer(psb_c_ipk_), value :: val
integer :: info
integer(psb_ipk_) :: info
character(len=80) :: fwhat
type(amg_dprec_type), pointer :: precp
@@ -94,7 +94,7 @@ contains
type(psb_c_object_type) :: ph
character(c_char) :: what(*)
real(c_double), value :: val
integer :: info
integer(psb_ipk_) :: info
character(len=80) :: fwhat
type(amg_dprec_type), pointer :: precp
@@ -122,7 +122,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph
character(c_char) :: what(*), val(*)
integer :: info
integer(psb_ipk_) :: info
character(len=80) :: fwhat,fval
type(amg_dprec_type), pointer :: precp
@@ -150,7 +150,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh
integer :: info
integer(psb_ipk_) :: info
type(amg_dprec_type), pointer :: precp
type(psb_dspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
@@ -189,7 +189,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh
integer :: info
integer(psb_ipk_) :: info
type(amg_dprec_type), pointer :: precp
type(psb_dspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
@@ -228,7 +228,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh
integer :: info
integer(psb_ipk_) :: info
type(amg_dprec_type), pointer :: precp
type(psb_dspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
@@ -302,7 +302,7 @@ contains
type(amg_dprec_type), pointer :: precp
type(psb_d_vect_type), pointer :: xp, bp
integer :: info,fitmax,fitrace,first,fistop,fiter
integer(psb_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
character(len=20) :: fmethd
real(kind(1.d0)) :: feps,ferr
@@ -358,7 +358,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph
integer :: info
integer(psb_ipk_) :: info
type(amg_dprec_type), pointer :: precp
character(len=80) :: fptype
cbind/amgprec/amg_zprec_cbind_mod.F90
+9 -9
View File
@@ -31,7 +31,7 @@ contains
type(amg_c_zprec) :: ph
type(psb_c_object_type), value :: cctxt
character(c_char) :: ptype(*)
integer :: info
integer(psb_ipk_) :: info
type(amg_zprec_type), pointer :: precp
character(len=80) :: fptype
@@ -64,7 +64,7 @@ contains
type(psb_c_object_type) :: ph
character(c_char) :: what(*)
integer(psb_c_ipk_), value :: val
integer :: info
integer(psb_ipk_) :: info
character(len=80) :: fwhat
type(amg_zprec_type), pointer :: precp
@@ -94,7 +94,7 @@ contains
type(psb_c_object_type) :: ph
character(c_char) :: what(*)
real(c_double), value :: val
integer :: info
integer(psb_ipk_) :: info
character(len=80) :: fwhat
type(amg_zprec_type), pointer :: precp
@@ -122,7 +122,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph
character(c_char) :: what(*), val(*)
integer :: info
integer(psb_ipk_) :: info
character(len=80) :: fwhat,fval
type(amg_zprec_type), pointer :: precp
@@ -150,7 +150,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh
integer :: info
integer(psb_ipk_) :: info
type(amg_zprec_type), pointer :: precp
type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
@@ -189,7 +189,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh
integer :: info
integer(psb_ipk_) :: info
type(amg_zprec_type), pointer :: precp
type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
@@ -228,7 +228,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh
integer :: info
integer(psb_ipk_) :: info
type(amg_zprec_type), pointer :: precp
type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
@@ -302,7 +302,7 @@ contains
type(amg_zprec_type), pointer :: precp
type(psb_z_vect_type), pointer :: xp, bp
integer :: info,fitmax,fitrace,first,fistop,fiter
integer(psb_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
character(len=20) :: fmethd
real(kind(1.d0)) :: feps,ferr
@@ -358,7 +358,7 @@ contains
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph
integer :: info
integer(psb_ipk_) :: info
type(amg_zprec_type), pointer :: precp
character(len=80) :: fptype
samples/advanced/fileread/amg_cf_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_cf_sample
call build_mtpart(aux_a,lnp)
endif
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
case default
@@ -589,9 +589,9 @@ program amg_cf_sample
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
samples/advanced/fileread/amg_df_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_df_sample
call build_mtpart(aux_a,lnp)
endif
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
case default
@@ -589,9 +589,9 @@ program amg_df_sample
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
samples/advanced/fileread/amg_sf_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_sf_sample
call build_mtpart(aux_a,lnp)
endif
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
case default
@@ -589,9 +589,9 @@ program amg_sf_sample
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
samples/advanced/fileread/amg_zf_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_zf_sample
call build_mtpart(aux_a,lnp)
endif
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
case default
@@ -589,9 +589,9 @@ program amg_zf_sample
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
samples/advanced/pdegen/amg_d_genpde_mod.F90
+14 -14
View File
@@ -275,7 +275,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0)
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero)
! Now let's split the 3D cube in hexahedra
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -319,7 +319,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -327,27 +327,27 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz < npz-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
@@ -741,7 +741,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iam,npx,npy,base=0)
call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero)
! Now let's split the 2D square in rectangles
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -781,7 +781,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -789,19 +789,19 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
samples/advanced/pdegen/amg_s_genpde_mod.F90
+14 -14
View File
@@ -275,7 +275,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0)
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero)
! Now let's split the 3D cube in hexahedra
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -319,7 +319,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -327,27 +327,27 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz < npz-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
@@ -741,7 +741,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iam,npx,npy,base=0)
call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero)
! Now let's split the 2D square in rectangles
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -781,7 +781,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -789,19 +789,19 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
samples/newslv/amg_d_tlu_solver_impl.f90
+4 -3
View File
@@ -55,15 +55,16 @@ subroutine amg_d_tlu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_tlu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables
integer :: n_row,n_col, nrow_a, nztota
integer :: np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: n_row, n_col, nrow_a, nztota
integer(psb_ipk_) :: np,me
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
type(psb_ctxt_type) :: ctxt
character(len=20) :: name='d_tlu_solver_bld', ch_err
samples/newslv/amg_pde3d_newslv.f90
+15 -15
View File
@@ -330,7 +330,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0)
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero)
! Now let's split the 3D cube in hexahedra
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -373,7 +373,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -381,27 +381,27 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz < npz-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
@@ -780,7 +780,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iam,npx,npy,base=0)
call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero)
! Now let's split the 2D square in rectangles
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -819,7 +819,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -827,19 +827,19 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
@@ -1144,7 +1144,7 @@ program amg_d_pde3d
end if
thier = psb_wtime()-t1
nlv = prec%get_nlevs()
call prec%set(tlusv, info,ilev=1,ilmax=max(1,nlv-1))
call prec%set(tlusv, info,ilev=1_psb_ipk_,ilmax=ione*max(1,nlv-1))
call psb_barrier(ctxt)
t1 = psb_wtime()
samples/simple/fileread/amg_cexample_1lev.f90
+17 -16
View File
@@ -73,21 +73,21 @@ program amg_cexample_1lev
! solver and preconditioner parameters
real(psb_spk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: i,info,j,m_problem
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_spk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name, kmethod
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -103,7 +103,7 @@ program amg_cexample_1lev
name='amg_cexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -152,14 +152,14 @@ program amg_cexample_1lev
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -177,7 +177,7 @@ program amg_cexample_1lev
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -198,7 +198,7 @@ program amg_cexample_1lev
! set number of overlaps
call P%set('SUB_OVR',2,info)
call P%set('SUB_OVR',itwo,info)
! build the preconditioner
@@ -226,7 +226,7 @@ program amg_cexample_1lev
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -263,9 +263,9 @@ program amg_cexample_1lev
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -306,10 +306,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: itmax
integer(psb_ipk_) :: itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/amg_cexample_ml.f90
+20 -19
View File
@@ -89,23 +89,23 @@ program amg_cexample_ml
! solver and preconditioner parameters
real(psb_spk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: choice
integer :: i,info,j,m_problem
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_spk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name
character(len=20), parameter :: kmethod='FCG'
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -121,7 +121,7 @@ program amg_cexample_ml
name='amg_cexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -170,14 +170,14 @@ program amg_cexample_ml
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -195,7 +195,7 @@ program amg_cexample_ml
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -228,7 +228,7 @@ program amg_cexample_ml
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SUBSOLVE','ILU',info)
call P%set('COARSE_SWEEPS',8,info)
call P%set('COARSE_SWEEPS',8_psb_ipk_,info)
case(3)
@@ -241,9 +241,9 @@ program amg_cexample_ml
call P%init(ctxt,'ML',info)
call P%set('PAR_AGGR_ALG','COUPLED',info)
call P%set('AGGR_TYPE','MATCHBOXP',info)
call P%set('AGGR_SIZE',8,info)
call P%set('AGGR_SIZE',8_psb_ipk_,info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('SMOOTHER_SWEEPS',itwo,info)
call P%set('COARSE_SOLVE','KRM',info)
call P%set('COARSE_MAT','DIST',info)
call P%set('KRM_METHOD','FCG',info)
@@ -275,7 +275,7 @@ program amg_cexample_ml
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -313,9 +313,9 @@ program amg_cexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -356,10 +356,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
integer(psb_ipk_) :: choice, itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/amg_dexample_1lev.f90
+17 -16
View File
@@ -73,21 +73,21 @@ program amg_dexample_1lev
! solver and preconditioner parameters
real(psb_dpk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: i,info,j,m_problem
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_dpk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name, kmethod
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -103,7 +103,7 @@ program amg_dexample_1lev
name='amg_dexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -152,14 +152,14 @@ program amg_dexample_1lev
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -177,7 +177,7 @@ program amg_dexample_1lev
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -198,7 +198,7 @@ program amg_dexample_1lev
! set number of overlaps
call P%set('SUB_OVR',2,info)
call P%set('SUB_OVR',itwo,info)
! build the preconditioner
@@ -226,7 +226,7 @@ program amg_dexample_1lev
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -263,9 +263,9 @@ program amg_dexample_1lev
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -306,10 +306,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: itmax
integer(psb_ipk_) :: itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/amg_dexample_ml.f90
+20 -19
View File
@@ -89,23 +89,23 @@ program amg_dexample_ml
! solver and preconditioner parameters
real(psb_dpk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: choice
integer :: i,info,j,m_problem
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_dpk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name
character(len=20), parameter :: kmethod='FCG'
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -121,7 +121,7 @@ program amg_dexample_ml
name='amg_dexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -170,14 +170,14 @@ program amg_dexample_ml
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -195,7 +195,7 @@ program amg_dexample_ml
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -228,7 +228,7 @@ program amg_dexample_ml
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SUBSOLVE','ILU',info)
call P%set('COARSE_SWEEPS',8,info)
call P%set('COARSE_SWEEPS',8_psb_ipk_,info)
case(3)
@@ -241,9 +241,9 @@ program amg_dexample_ml
call P%init(ctxt,'ML',info)
call P%set('PAR_AGGR_ALG','COUPLED',info)
call P%set('AGGR_TYPE','MATCHBOXP',info)
call P%set('AGGR_SIZE',8,info)
call P%set('AGGR_SIZE',8_psb_ipk_,info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('SMOOTHER_SWEEPS',itwo,info)
call P%set('COARSE_SOLVE','KRM',info)
call P%set('COARSE_MAT','DIST',info)
call P%set('KRM_METHOD','FCG',info)
@@ -275,7 +275,7 @@ program amg_dexample_ml
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -313,9 +313,9 @@ program amg_dexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -356,10 +356,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
integer(psb_ipk_) :: choice, itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/amg_sexample_1lev.f90
+17 -16
View File
@@ -73,21 +73,21 @@ program amg_sexample_1lev
! solver and preconditioner parameters
real(psb_spk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: i,info,j,m_problem
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_spk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name, kmethod
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -103,7 +103,7 @@ program amg_sexample_1lev
name='amg_sexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -152,14 +152,14 @@ program amg_sexample_1lev
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -177,7 +177,7 @@ program amg_sexample_1lev
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -198,7 +198,7 @@ program amg_sexample_1lev
! set number of overlaps
call P%set('SUB_OVR',2,info)
call P%set('SUB_OVR',itwo,info)
! build the preconditioner
@@ -226,7 +226,7 @@ program amg_sexample_1lev
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -263,9 +263,9 @@ program amg_sexample_1lev
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -306,10 +306,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: itmax
integer(psb_ipk_) :: itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/amg_sexample_ml.f90
+20 -19
View File
@@ -89,23 +89,23 @@ program amg_sexample_ml
! solver and preconditioner parameters
real(psb_spk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: choice
integer :: i,info,j,m_problem
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_spk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name
character(len=20), parameter :: kmethod='FCG'
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -121,7 +121,7 @@ program amg_sexample_ml
name='amg_sexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -170,14 +170,14 @@ program amg_sexample_ml
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -195,7 +195,7 @@ program amg_sexample_ml
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -228,7 +228,7 @@ program amg_sexample_ml
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SUBSOLVE','ILU',info)
call P%set('COARSE_SWEEPS',8,info)
call P%set('COARSE_SWEEPS',8_psb_ipk_,info)
case(3)
@@ -241,9 +241,9 @@ program amg_sexample_ml
call P%init(ctxt,'ML',info)
call P%set('PAR_AGGR_ALG','COUPLED',info)
call P%set('AGGR_TYPE','MATCHBOXP',info)
call P%set('AGGR_SIZE',8,info)
call P%set('AGGR_SIZE',8_psb_ipk_,info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('SMOOTHER_SWEEPS',itwo,info)
call P%set('COARSE_SOLVE','KRM',info)
call P%set('COARSE_MAT','DIST',info)
call P%set('KRM_METHOD','FCG',info)
@@ -275,7 +275,7 @@ program amg_sexample_ml
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -313,9 +313,9 @@ program amg_sexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -356,10 +356,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
integer(psb_ipk_) :: choice, itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/amg_zexample_1lev.f90
+17 -16
View File
@@ -73,21 +73,21 @@ program amg_zexample_1lev
! solver and preconditioner parameters
real(psb_dpk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: i,info,j,m_problem
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_dpk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name, kmethod
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -103,7 +103,7 @@ program amg_zexample_1lev
name='amg_zexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -152,14 +152,14 @@ program amg_zexample_1lev
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -177,7 +177,7 @@ program amg_zexample_1lev
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -198,7 +198,7 @@ program amg_zexample_1lev
! set number of overlaps
call P%set('SUB_OVR',2,info)
call P%set('SUB_OVR',itwo,info)
! build the preconditioner
@@ -226,7 +226,7 @@ program amg_zexample_1lev
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -263,9 +263,9 @@ program amg_zexample_1lev
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -306,10 +306,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: itmax
integer(psb_ipk_) :: itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/amg_zexample_ml.f90
+20 -19
View File
@@ -89,23 +89,23 @@ program amg_zexample_ml
! solver and preconditioner parameters
real(psb_dpk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: choice
integer :: i,info,j,m_problem
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_epk_) :: amatsize, precsize, descsize
integer :: ierr, ircode
integer(psb_ipk_) :: ierr, ircode
real(psb_dpk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=20) :: name
character(len=20), parameter :: kmethod='FCG'
integer, parameter :: iunit=12
integer(psb_ipk_), parameter :: iunit=12
! initialize the parallel environment
@@ -121,7 +121,7 @@ program amg_zexample_ml
name='amg_zexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -170,14 +170,14 @@ program amg_zexample_ml
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
if (psb_size(aux_b,ione) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
b_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
call psb_realloc(m_problem,ione,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -195,7 +195,7 @@ program amg_zexample_ml
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_)
t2 = psb_wtime() - t1
@@ -228,7 +228,7 @@ program amg_zexample_ml
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SUBSOLVE','ILU',info)
call P%set('COARSE_SWEEPS',8,info)
call P%set('COARSE_SWEEPS',8_psb_ipk_,info)
case(3)
@@ -241,9 +241,9 @@ program amg_zexample_ml
call P%init(ctxt,'ML',info)
call P%set('PAR_AGGR_ALG','COUPLED',info)
call P%set('AGGR_TYPE','MATCHBOXP',info)
call P%set('AGGR_SIZE',8,info)
call P%set('AGGR_SIZE',8_psb_ipk_,info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('SMOOTHER_SWEEPS',itwo,info)
call P%set('COARSE_SOLVE','KRM',info)
call P%set('COARSE_MAT','DIST',info)
call P%set('KRM_METHOD','FCG',info)
@@ -275,7 +275,7 @@ program amg_zexample_ml
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -313,9 +313,9 @@ program amg_zexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
& call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(0,'(" ")')
@@ -356,10 +356,11 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
integer(psb_ipk_) :: choice, itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
integer(psb_ipk_) :: inp_unit
integer(psb_mpk_) :: iam, np
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/fileread/data_input.f90
+7 -10
View File
@@ -32,11 +32,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
module data_input
use psb_base_mod, only : psb_ipk_
interface read_data
module procedure read_char, read_int,&
& read_double, read_single,&
@@ -54,7 +51,7 @@ contains
subroutine read_char(val,file,marker)
character(len=*), intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -63,8 +60,8 @@ contains
end subroutine read_char
subroutine read_int(val,file,marker)
integer, intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(out) :: val
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -74,7 +71,7 @@ contains
subroutine read_single(val,file,marker)
use psb_base_mod
real(psb_spk_), intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -84,7 +81,7 @@ contains
subroutine read_double(val,file,marker)
use psb_base_mod
real(psb_dpk_), intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -112,7 +109,7 @@ contains
end subroutine string_read_char
subroutine string_read_int(val,file,marker)
integer, intent(out) :: val
integer(psb_ipk_), intent(out) :: val
character(len=*), intent(in) :: file
character(len=1), optional, intent(in) :: marker
character(len=1) :: marker_
samples/simple/pdegen/amg_dexample_1lev.f90
+10 -9
View File
@@ -81,17 +81,17 @@ program amg_dexample_1lev
! solver parameters
real(psb_dpk_) :: tol, err
integer :: itmax, iter, itrace, istop
integer(psb_ipk_) :: itmax, iter, itrace, istop
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: i,info,j
integer(psb_ipk_) :: i,info,j
integer(psb_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer :: idim, nlev, ierr, ircode
integer(psb_ipk_) :: idim, nlev, ierr, ircode
real(psb_dpk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=5) :: afmt='CSR'
@@ -110,7 +110,7 @@ program amg_dexample_1lev
name='amg_dexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -146,7 +146,7 @@ program amg_dexample_1lev
! set number of overlaps
call P%set('SUB_OVR',2,info)
call P%set('SUB_OVR',itwo,info)
! build the preconditioner
@@ -174,7 +174,7 @@ program amg_dexample_1lev
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -236,9 +236,10 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: idim, itmax
integer(psb_ipk_) :: idim, itmax
real(psb_dpk_) :: tol
integer :: iam, np, inp_unit
integer(psb_mpk_) :: iam, np
integer(psb_ipk_) :: inp_unit
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/pdegen/amg_dexample_ml.f90
+14 -13
View File
@@ -105,19 +105,19 @@ program amg_dexample_ml
! solver and preconditioner parameters
real(psb_dpk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: choice
integer :: i,info,j
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j
integer(psb_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer :: idim, ierr, ircode
integer(psb_ipk_) :: idim, ierr, ircode
real(psb_dpk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=5) :: afmt='CSR'
@@ -138,7 +138,7 @@ program amg_dexample_ml
name='amg_dexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -189,7 +189,7 @@ program amg_dexample_ml
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SUBSOLVE','ILU',info)
call P%set('COARSE_SWEEPS',8,info)
call P%set('COARSE_SWEEPS',8_psb_ipk_,info)
case(3)
@@ -202,9 +202,9 @@ program amg_dexample_ml
call P%init(ctxt,'ML',info)
call P%set('PAR_AGGR_ALG','COUPLED',info)
call P%set('AGGR_TYPE','MATCHBOXP',info)
call P%set('AGGR_SIZE',8,info)
call P%set('AGGR_SIZE',8_psb_ipk_,info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('SMOOTHER_SWEEPS',itwo,info)
call P%set('COARSE_SOLVE','KRM',info)
call P%set('COARSE_MAT','DIST',info)
call P%set('KRM_METHOD','FCG',info)
@@ -237,7 +237,7 @@ program amg_dexample_ml
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -299,9 +299,10 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: choice, idim, itmax
integer(psb_ipk_) :: choice, idim, itmax
real(psb_dpk_) :: tol
integer :: iam, np, inp_unit
integer(psb_mpk_) :: iam, np
integer(psb_ipk_) :: inp_unit
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/pdegen/amg_dpde_mod.f90
+8 -8
View File
@@ -237,7 +237,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0)
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero)
! Now let's split the 3D cube in hexahedra
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -280,7 +280,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -288,27 +288,27 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz < npz-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
samples/simple/pdegen/amg_sexample_1lev.f90
+10 -9
View File
@@ -81,17 +81,17 @@ program amg_sexample_1lev
! solver parameters
real(psb_spk_) :: tol, err
integer :: itmax, iter, itrace, istop
integer(psb_ipk_) :: itmax, iter, itrace, istop
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: i,info,j
integer(psb_ipk_) :: i,info,j
integer(psb_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer :: idim, nlev, ierr, ircode
integer(psb_ipk_) :: idim, nlev, ierr, ircode
real(psb_spk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=5) :: afmt='CSR'
@@ -110,7 +110,7 @@ program amg_sexample_1lev
name='amg_sexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -146,7 +146,7 @@ program amg_sexample_1lev
! set number of overlaps
call P%set('SUB_OVR',2,info)
call P%set('SUB_OVR',itwo,info)
! build the preconditioner
@@ -174,7 +174,7 @@ program amg_sexample_1lev
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -236,9 +236,10 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: idim, itmax
integer(psb_ipk_) :: idim, itmax
real(psb_spk_) :: tol
integer :: iam, np, inp_unit
integer(psb_mpk_) :: iam, np
integer(psb_ipk_) :: inp_unit
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/pdegen/amg_sexample_ml.f90
+14 -13
View File
@@ -105,19 +105,19 @@ program amg_sexample_ml
! solver and preconditioner parameters
real(psb_spk_) :: tol, err
integer :: itmax, iter, istop
integer :: nlev
integer(psb_ipk_) :: itmax, iter, istop
integer(psb_ipk_) :: nlev
! parallel environment parameters
type(psb_ctxt_type) :: ctxt
integer :: iam, np
integer(psb_ipk_) :: iam, np
! other variables
integer :: choice
integer :: i,info,j
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j
integer(psb_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer :: idim, ierr, ircode
integer(psb_ipk_) :: idim, ierr, ircode
real(psb_spk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=5) :: afmt='CSR'
@@ -138,7 +138,7 @@ program amg_sexample_ml
name='amg_sexample_ml'
if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_
call psb_set_errverbosity(2)
call psb_set_errverbosity(itwo)
!
! Hello world
!
@@ -189,7 +189,7 @@ program amg_sexample_ml
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SUBSOLVE','ILU',info)
call P%set('COARSE_SWEEPS',8,info)
call P%set('COARSE_SWEEPS',8_psb_ipk_,info)
case(3)
@@ -202,9 +202,9 @@ program amg_sexample_ml
call P%init(ctxt,'ML',info)
call P%set('PAR_AGGR_ALG','COUPLED',info)
call P%set('AGGR_TYPE','MATCHBOXP',info)
call P%set('AGGR_SIZE',8,info)
call P%set('AGGR_SIZE',8_psb_ipk_,info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('SMOOTHER_SWEEPS',itwo,info)
call P%set('COARSE_SOLVE','KRM',info)
call P%set('COARSE_MAT','DIST',info)
call P%set('KRM_METHOD','FCG',info)
@@ -237,7 +237,7 @@ program amg_sexample_ml
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo)
t2 = psb_wtime() - t1
call psb_amx(ctxt,t2)
@@ -299,9 +299,10 @@ contains
implicit none
type(psb_ctxt_type) :: ctxt
integer :: choice, idim, itmax
integer(psb_ipk_) :: choice, idim, itmax
real(psb_spk_) :: tol
integer :: iam, np, inp_unit
integer(psb_mpk_) :: iam, np
integer(psb_ipk_) :: inp_unit
character(len=1024) :: filename
call psb_info(ctxt,iam,np)
samples/simple/pdegen/amg_spde_mod.f90
+8 -8
View File
@@ -237,7 +237,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0)
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero)
! Now let's split the 3D cube in hexahedra
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -280,7 +280,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -288,27 +288,27 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz < npz-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
samples/simple/pdegen/data_input.f90
+7 -7
View File
@@ -33,7 +33,7 @@
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
module data_input
use psb_base_mod, only : psb_ipk_
interface read_data
module procedure read_char, read_int,&
& read_double, read_single,&
@@ -51,7 +51,7 @@ contains
subroutine read_char(val,file,marker)
character(len=*), intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -60,8 +60,8 @@ contains
end subroutine read_char
subroutine read_int(val,file,marker)
integer, intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(out) :: val
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -71,7 +71,7 @@ contains
subroutine read_single(val,file,marker)
use psb_base_mod
real(psb_spk_), intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -81,7 +81,7 @@ contains
subroutine read_double(val,file,marker)
use psb_base_mod
real(psb_dpk_), intent(out) :: val
integer, intent(in) :: file
integer(psb_ipk_), intent(in) :: file
character(len=1), optional, intent(in) :: marker
read(file,'(a)')charbuf
@@ -109,7 +109,7 @@ contains
end subroutine string_read_char
subroutine string_read_int(val,file,marker)
integer, intent(out) :: val
integer(psb_ipk_), intent(out) :: val
character(len=*), intent(in) :: file
character(len=1), optional, intent(in) :: marker
character(len=1) :: marker_