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

Merge branch 'development' into cmake

Browse Source
cmake
Luca Pepè Sciarria 11 months ago
parent 6214a918f1 b724a324c9
commit b7edff0848
54 changed files with 415 additions and 383 deletions
Show Stats Download Patch File Download Diff File

6
README.md
Unescape Escape View File

@ -74,3 +74,9 @@ In the European project “Energy oriented Center of Excellence: toward exascale
- Fabio Durastante (University of Pisa and IAC-CNR, IT)
- Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR, IT)
**Contributors** (_roughly reverse cronological order_):
- Luca Pepè Sciarria
- Andea Di Iorio
- Ambra Abdullahi Hassan
- Alfredo Buttari

12
amgprec/amg_base_prec_type.F90
Unescape Escape 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)

5
amgprec/amg_d_matchboxp_mod.F90
Unescape Escape 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
!

5
amgprec/amg_s_matchboxp_mod.F90
Unescape Escape 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
!

13
amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90
Unescape Escape View File

@ -108,7 +108,7 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
!
type(psb_ctxt_type) :: ictxt
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
type(psb_ld_coo_sparse_mat) :: tmpcoo
type(psb_ldspmat_type) :: tmp_ac
@ -124,8 +124,8 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
if (psb_get_errstatus().ne.0) then
write(0,*) me,' From:',trim(name),':',psb_get_errstatus()
return
@ -163,22 +163,21 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
call op_prol%mv_to(tmpcoo)
nzl = tmpcoo%get_nzeros()
call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
call tmpcoo%set_ncols(i_nr)
call op_prol%mv_from(tmpcoo)
call op_restr%mv_to(tmpcoo)
nzl = tmpcoo%get_nzeros()
call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
call tmpcoo%set_nrows(i_nr)
call op_restr%mv_from(tmpcoo)
call op_prol%set_ncols(i_nr)
call op_restr%set_nrows(i_nr)
call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
& dupl=psb_dupl_add_,keeploc=.false.)
call tmp_ac%mv_to(tmpcoo)
call ac%mv_from(tmpcoo)
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info)
!
! Now that we have the descriptors and the restrictor, we should

13
amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90
Unescape Escape View File

@ -108,7 +108,7 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
!
type(psb_ctxt_type) :: ictxt
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
type(psb_ls_coo_sparse_mat) :: tmpcoo
type(psb_lsspmat_type) :: tmp_ac
@ -124,8 +124,8 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
if (psb_get_errstatus().ne.0) then
write(0,*) me,' From:',trim(name),':',psb_get_errstatus()
return
@ -163,22 +163,21 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
call op_prol%mv_to(tmpcoo)
nzl = tmpcoo%get_nzeros()
call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
call tmpcoo%set_ncols(i_nr)
call op_prol%mv_from(tmpcoo)
call op_restr%mv_to(tmpcoo)
nzl = tmpcoo%get_nzeros()
call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
call tmpcoo%set_nrows(i_nr)
call op_restr%mv_from(tmpcoo)
call op_prol%set_ncols(i_nr)
call op_restr%set_nrows(i_nr)
call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
& dupl=psb_dupl_add_,keeploc=.false.)
call tmp_ac%mv_to(tmpcoo)
call ac%mv_from(tmpcoo)
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info)
!
! Now that we have the descriptors and the restrictor, we should

4
amgprec/impl/level/amg_c_base_onelev_map_prol.F90
Unescape Escape 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

4
amgprec/impl/level/amg_c_base_onelev_map_rstr.F90
Unescape Escape 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

4
amgprec/impl/level/amg_d_base_onelev_map_prol.F90
Unescape Escape 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

4
amgprec/impl/level/amg_d_base_onelev_map_rstr.F90
Unescape Escape 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

4
amgprec/impl/level/amg_s_base_onelev_map_prol.F90
Unescape Escape 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

4
amgprec/impl/level/amg_s_base_onelev_map_rstr.F90
Unescape Escape 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

4
amgprec/impl/level/amg_z_base_onelev_map_prol.F90
Unescape Escape 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

4
amgprec/impl/level/amg_z_base_onelev_map_rstr.F90
Unescape Escape 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

4
amgprec/impl/smoother/amg_c_jac_smoother_apply_vect.f90
Unescape Escape 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

4
amgprec/impl/smoother/amg_d_jac_smoother_apply_vect.f90
Unescape Escape 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

4
amgprec/impl/smoother/amg_s_jac_smoother_apply_vect.f90
Unescape Escape 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

4
amgprec/impl/smoother/amg_z_jac_smoother_apply_vect.f90
Unescape Escape 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

11
amgprec/impl/solver/amg_c_krm_solver_impl.f90
Unescape Escape 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

11
amgprec/impl/solver/amg_d_krm_solver_impl.f90
Unescape Escape 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

11
amgprec/impl/solver/amg_s_krm_solver_impl.f90
Unescape Escape 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

11
amgprec/impl/solver/amg_z_krm_solver_impl.f90
Unescape Escape 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

2
cbind/amgprec/amg_c_dprec.c
Unescape Escape 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);

2
cbind/amgprec/amg_c_zprec.c
Unescape Escape 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);

18
cbind/amgprec/amg_dprec_cbind_mod.F90
Unescape Escape 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

18
cbind/amgprec/amg_zprec_cbind_mod.F90
Unescape Escape 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

6
samples/advanced/fileread/amg_cf_sample.f90
Unescape Escape 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,'(" ")')

6
samples/advanced/fileread/amg_df_sample.f90
Unescape Escape 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,'(" ")')

6
samples/advanced/fileread/amg_sf_sample.f90
Unescape Escape 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,'(" ")')

6
samples/advanced/fileread/amg_zf_sample.f90
Unescape Escape 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,'(" ")')

28
samples/advanced/pdegen/amg_d_genpde_mod.F90
Unescape Escape 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)

10
samples/advanced/pdegen/amg_d_pde2d.F90
Unescape Escape View File

@ -568,11 +568,11 @@ program amg_d_pde2d
write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier
write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx
write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp
write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize
write(psb_out_unit,'("Total memory occupation : ",i12)') &
write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize
write(psb_out_unit,'("Total memory occupation : ",i16)') &
& amatsize + descsize+precsize+2*vecsize
write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt()
write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt()

10
samples/advanced/pdegen/amg_d_pde3d.F90
Unescape Escape View File

@ -572,11 +572,11 @@ program amg_d_pde3d
write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier
write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx
write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp
write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize
write(psb_out_unit,'("Total memory occupation : ",i12)') &
write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize
write(psb_out_unit,'("Total memory occupation : ",i16)') &
& amatsize + descsize+precsize+2*vecsize
write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt()
write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt()

28
samples/advanced/pdegen/amg_s_genpde_mod.F90
Unescape Escape 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)

10
samples/advanced/pdegen/amg_s_pde2d.F90
Unescape Escape View File

@ -568,11 +568,11 @@ program amg_s_pde2d
write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier
write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx
write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp
write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize
write(psb_out_unit,'("Total memory occupation : ",i12)') &
write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize
write(psb_out_unit,'("Total memory occupation : ",i16)') &
& amatsize + descsize+precsize+2*vecsize
write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt()
write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt()

10
samples/advanced/pdegen/amg_s_pde3d.F90
Unescape Escape View File

@ -572,11 +572,11 @@ program amg_s_pde3d
write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier
write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx
write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp
write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize
write(psb_out_unit,'("Total memory occupation : ",i12)') &
write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize
write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize
write(psb_out_unit,'("Total memory occupation : ",i16)') &
& amatsize + descsize+precsize+2*vecsize
write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt()
write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt()

7
samples/newslv/amg_d_tlu_solver_impl.f90
Unescape Escape 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

30
samples/newslv/amg_pde3d_newslv.f90
Unescape Escape 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()

33
samples/simple/fileread/amg_cexample_1lev.f90
Unescape Escape 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)

39
samples/simple/fileread/amg_cexample_ml.f90
Unescape Escape 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)

33
samples/simple/fileread/amg_dexample_1lev.f90
Unescape Escape 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)

39
samples/simple/fileread/amg_dexample_ml.f90
Unescape Escape 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)

33
samples/simple/fileread/amg_sexample_1lev.f90
Unescape Escape 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)

39
samples/simple/fileread/amg_sexample_ml.f90
Unescape Escape 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)

33
samples/simple/fileread/amg_zexample_1lev.f90
Unescape Escape 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)

39
samples/simple/fileread/amg_zexample_ml.f90
Unescape Escape 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)

17
samples/simple/fileread/data_input.f90
Unescape Escape 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_

19
samples/simple/pdegen/amg_dexample_1lev.f90
Unescape Escape 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)

33
samples/simple/pdegen/amg_dexample_ml.f90
Unescape Escape View File

@ -105,20 +105,20 @@ 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_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer :: idim, ierr, ircode
real(psb_dpk_) :: resmx, resmxp
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j
integer(psb_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer(psb_ipk_) :: idim, ierr, ircode
real(psb_dpk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=5) :: afmt='CSR'
character(len=20) :: name
@ -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)

16
samples/simple/pdegen/amg_dpde_mod.f90
Unescape Escape 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)

19
samples/simple/pdegen/amg_sexample_1lev.f90
Unescape Escape 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)

33
samples/simple/pdegen/amg_sexample_ml.f90
Unescape Escape View File

@ -105,20 +105,20 @@ 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_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer :: idim, ierr, ircode
real(psb_spk_) :: resmx, resmxp
integer(psb_ipk_) :: choice
integer(psb_ipk_) :: i,info,j
integer(psb_epk_) :: amatsize, precsize, descsize
integer(psb_epk_) :: system_size
integer(psb_ipk_) :: idim, ierr, ircode
real(psb_spk_) :: resmx, resmxp
real(psb_dpk_) :: t1, t2, tprec
character(len=5) :: afmt='CSR'
character(len=20) :: name
@ -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)

16
samples/simple/pdegen/amg_spde_mod.f90
Unescape Escape 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)

14
samples/simple/pdegen/data_input.f90
Unescape Escape 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_

Write Preview
Loading…
Cancel
Save