From 9b6f567f783e2c6f135395fe5b580ad1fc3e194d Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 10 Dec 2012 15:00:20 +0000 Subject: [PATCH] mld2p4-2-dev tests/pdegen/data_input.f90 tests/pdegen/runs/ppde.inp tests/pdegen/ppde2d.f90 tests/fileread/data_input.f90 tests/fileread/cf_sample.f90 tests/fileread/sf_sample.f90 tests/fileread/runs/dfs.inp tests/fileread/df_sample.f90 tests/fileread/zf_sample.f90 Fixes for data_input. To be tested. --- tests/fileread/cf_sample.f90 | 110 +++++++++++++++--------------- tests/fileread/data_input.f90 | 34 +++++----- tests/fileread/df_sample.f90 | 122 +++++++++++++++++----------------- tests/fileread/runs/dfs.inp | 1 - tests/fileread/sf_sample.f90 | 118 ++++++++++++++++---------------- tests/fileread/zf_sample.f90 | 114 +++++++++++++++---------------- tests/pdegen/data_input.f90 | 36 +++++++++- tests/pdegen/ppde2d.f90 | 1 + tests/pdegen/runs/ppde.inp | 2 +- 9 files changed, 283 insertions(+), 255 deletions(-) diff --git a/tests/fileread/cf_sample.f90 b/tests/fileread/cf_sample.f90 index 20b3d206..9b6874a2 100644 --- a/tests/fileread/cf_sample.f90 +++ b/tests/fileread/cf_sample.f90 @@ -51,15 +51,15 @@ program cf_sample type precdata character(len=20) :: descr ! verbose description of the prec character(len=10) :: prec ! overall prectype - integer :: novr ! number of overlap layers - integer :: jsweeps ! Jacobi/smoother sweeps + integer(psb_ipk_) :: novr ! number of overlap layers + integer(psb_ipk_) :: jsweeps ! Jacobi/smoother sweeps character(len=16) :: restr ! restriction over application of AS character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! factorization type: ILU, SuperLU, UMFPACK - integer :: fill ! fillin for factorization + integer(psb_ipk_) :: fill ! fillin for factorization real(psb_spk_) :: thr ! threshold for fact. ILU(T) character(len=16) :: smther ! Smoother - integer :: nlev ! number of levels in multilevel prec. + integer(psb_ipk_) :: nlev ! number of levels in multilevel prec. character(len=16) :: aggrkind ! smoothed, raw aggregation character(len=16) :: aggr_alg ! aggregation algorithm (currently only decoupled) character(len=16) :: mltype ! additive or multiplicative multi-level prec @@ -67,9 +67,9 @@ program cf_sample character(len=16) :: cmat ! coarse mat: distributed, replicated character(len=16) :: csolve ! coarse solver: bjac, umf, slu, sludist character(len=16) :: csbsolve ! coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK - integer :: cfill ! fillin for coarse factorization + integer(psb_ipk_) :: cfill ! fillin for coarse factorization real(psb_spk_) :: cthres ! threshold for coarse fact. ILU(T) - integer :: cjswp ! block-Jacobi sweeps + integer(psb_ipk_) :: cjswp ! block-Jacobi sweeps real(psb_spk_) :: athres ! smoothed aggregation threshold end type precdata type(precdata) :: prec_choice @@ -89,26 +89,26 @@ program cf_sample ! communications data structure type(psb_desc_type):: desc_a - integer :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np ! solver paramters - integer :: iter, itmax, ierr, itrace, ircode, ipart,& + integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& & methd, istopc, irst, nlv integer(psb_long_int_k_) :: amatsize, precsize, descsize real(psb_spk_) :: err, eps character(len=5) :: afmt character(len=20) :: name - integer, parameter :: iunit=12 - integer :: iparm(20) + integer(psb_ipk_), parameter :: iunit=12 + integer(psb_ipk_) :: iparm(20) ! other variables - integer :: i,info,j,m_problem - integer :: internal, m,ii,nnzero - real(psb_dpk_) :: t1, t2, tprec - real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp - integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer(psb_ipk_) :: i,info,j,m_problem + integer(psb_ipk_) :: internal, m,ii,nnzero + real(psb_dpk_) :: t1, t2, tprec + real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp + integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) call psb_init(ictxt) call psb_info(ictxt,iam,np) @@ -123,7 +123,7 @@ program cf_sample name='sf_sample' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -172,7 +172,7 @@ program cf_sample call psb_bcast(ictxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,dim=1) == m_problem) then + if (psb_size(aux_b,dim=ione) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) @@ -384,51 +384,51 @@ contains use psb_base_mod implicit none - integer :: icontxt + integer(psb_ipk_) :: icontxt character(len=*) :: kmethd, mtrx, rhs, afmt,filefmt type(precdata) :: prec real(psb_spk_) :: eps - integer :: iret, istopc,itmax,itrace, ipart, irst - integer :: iam, nm, np, i + integer(psb_ipk_) :: iret, istopc,itmax,itrace, ipart, irst + integer(psb_ipk_) :: iam, nm, np, i call psb_info(icontxt,iam,np) if (iam == psb_root_) then ! read input parameters - call read_data(mtrx,5) - call read_data(rhs,5) - call read_data(filefmt,5) - call read_data(kmethd,5) - call read_data(afmt,5) - call read_data(ipart,5) - call read_data(istopc,5) - call read_data(itmax,5) - call read_data(itrace,5) - call read_data(irst,5) - call read_data(eps,5) - call read_data(prec%descr,5) ! verbose description of the prec - call read_data(prec%prec,5) ! overall prectype - call read_data(prec%novr,5) ! number of overlap layers - call read_data(prec%restr,5) ! restriction over application of as - call read_data(prec%prol,5) ! prolongation over application of as - call read_data(prec%solve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%fill,5) ! Fill-in for factorization - call read_data(prec%thr,5) ! Threshold for fact. ILU(T) - call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC + call read_data(mtrx,psb_inp_unit) + call read_data(rhs,psb_inp_unit) + call read_data(filefmt,psb_inp_unit) + call read_data(kmethd,psb_inp_unit) + call read_data(afmt,psb_inp_unit) + call read_data(ipart,psb_inp_unit) + call read_data(istopc,psb_inp_unit) + call read_data(itmax,psb_inp_unit) + call read_data(itrace,psb_inp_unit) + call read_data(irst,psb_inp_unit) + call read_data(eps,psb_inp_unit) + call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec + call read_data(prec%prec,psb_inp_unit) ! overall prectype + call read_data(prec%novr,psb_inp_unit) ! number of overlap layers + call read_data(prec%restr,psb_inp_unit) ! restriction over application of as + call read_data(prec%prol,psb_inp_unit) ! prolongation over application of as + call read_data(prec%solve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%fill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%thr,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%jsweeps,psb_inp_unit) ! Jacobi sweeps for PJAC if (psb_toupper(prec%prec) == 'ML') then - call read_data(prec%nlev,5) ! Number of levels in multilevel prec. - call read_data(prec%smther,5) ! Smoother type. - call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin - call read_data(prec%aggr_alg,5) ! local or global aggregation - call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec - call read_data(prec%smthpos,5) ! side: pre, post, both smoothing - call read_data(prec%cmat,5) ! coarse mat - call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%cfill,5) ! Fill-in for factorization - call read_data(prec%cthres,5) ! Threshold for fact. ILU(T) - call read_data(prec%cjswp,5) ! Jacobi sweeps - call read_data(prec%athres,5) ! smoother aggr thresh + call read_data(prec%nlev,psb_inp_unit) ! Number of levels in multilevel prec. + call read_data(prec%smther,psb_inp_unit) ! Smoother type. + call read_data(prec%aggrkind,psb_inp_unit) ! smoothed/raw aggregatin + call read_data(prec%aggr_alg,psb_inp_unit) ! local or global aggregation + call read_data(prec%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec + call read_data(prec%smthpos,psb_inp_unit) ! side: pre, post, both smoothing + call read_data(prec%cmat,psb_inp_unit) ! coarse mat + call read_data(prec%csolve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%csbsolve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%cfill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%cthres,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%cjswp,psb_inp_unit) ! Jacobi sweeps + call read_data(prec%athres,psb_inp_unit) ! smoother aggr thresh end if end if @@ -471,7 +471,7 @@ contains end subroutine get_parms subroutine pr_usage(iout) - integer iout + integer(psb_ipk_) iout write(iout, *) ' number of parameters is incorrect!' write(iout, *) ' use: hb_sample mtrx_file methd prec [ptype & &itmax istopc itrace]' diff --git a/tests/fileread/data_input.f90 b/tests/fileread/data_input.f90 index 82047a53..dcae78fa 100644 --- a/tests/fileread/data_input.f90 +++ b/tests/fileread/data_input.f90 @@ -37,6 +37,7 @@ !!$ !!$ module data_input + use psb_base_mod, only : psb_spk_, psb_dpk_, psb_ipk_ interface read_data module procedure read_char, read_int,& @@ -56,7 +57,7 @@ contains subroutine read_logical(val,file,marker) logical, intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -66,7 +67,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 @@ -74,10 +75,9 @@ 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 @@ -85,9 +85,8 @@ contains end subroutine read_int 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 @@ -95,9 +94,8 @@ contains end subroutine read_single 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 @@ -111,7 +109,7 @@ contains character(len=1), optional, intent(in) :: marker character(len=1) :: marker_ character(len=1024) :: charbuf - integer :: idx + integer(psb_ipk_) :: idx if (present(marker)) then marker_ = marker else @@ -125,12 +123,12 @@ 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_ character(len=1024) :: charbuf - integer :: idx + integer(psb_ipk_) :: idx if (present(marker)) then marker_ = marker else @@ -144,13 +142,12 @@ contains end subroutine string_read_int subroutine string_read_single(val,file,marker) - use psb_base_mod real(psb_spk_), intent(out) :: val character(len=*), intent(in) :: file character(len=1), optional, intent(in) :: marker character(len=1) :: marker_ character(len=1024) :: charbuf - integer :: idx + integer(psb_ipk_) :: idx if (present(marker)) then marker_ = marker else @@ -164,13 +161,12 @@ contains end subroutine string_read_single subroutine string_read_double(val,file,marker) - use psb_base_mod real(psb_dpk_), intent(out) :: val character(len=*), intent(in) :: file character(len=1), optional, intent(in) :: marker character(len=1) :: marker_ character(len=1024) :: charbuf - integer :: idx + integer(psb_ipk_) :: idx if (present(marker)) then marker_ = marker else @@ -184,13 +180,12 @@ contains end subroutine string_read_double subroutine string_read_logical(val,file,marker) - use psb_base_mod logical, intent(out) :: val character(len=*), intent(in) :: file character(len=1), optional, intent(in) :: marker character(len=1) :: marker_ character(len=1024) :: charbuf - integer :: idx + integer(psb_ipk_) :: idx if (present(marker)) then marker_ = marker else @@ -200,6 +195,7 @@ contains charbuf = adjustl(charbuf) idx=index(charbuf,marker_) if (idx == 0) idx = len(charbuf)+1 + write(0,*) ' From string_read_logical: ',idx read(charbuf(1:idx-1),*) val end subroutine string_read_logical @@ -208,7 +204,7 @@ contains character(len=1), optional, intent(in) :: marker character(len=len(string)) :: trim_string character(len=1) :: marker_ - integer :: idx + integer(psb_ipk_) :: idx if (present(marker)) then marker_ = marker else diff --git a/tests/fileread/df_sample.f90 b/tests/fileread/df_sample.f90 index a20db7b3..63a87af3 100644 --- a/tests/fileread/df_sample.f90 +++ b/tests/fileread/df_sample.f90 @@ -51,15 +51,15 @@ program df_sample type precdata character(len=20) :: descr ! verbose description of the prec character(len=10) :: prec ! overall prectype - integer :: novr ! number of overlap layers - integer :: jsweeps ! Jacobi/smoother sweeps + integer(psb_ipk_) :: novr ! number of overlap layers + integer(psb_ipk_) :: jsweeps ! Jacobi/smoother sweeps character(len=16) :: restr ! restriction over application of AS character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! factorization type: ILU, SuperLU, UMFPACK - integer :: fill ! fillin for factorization + integer(psb_ipk_) :: fill ! fillin for factorization real(psb_dpk_) :: thr ! threshold for fact. ILU(T) character(len=16) :: smther ! Smoother - integer :: nlev ! number of levels in multilevel prec. + integer(psb_ipk_) :: nlev ! number of levels in multilevel prec. character(len=16) :: aggrkind ! smoothed, raw aggregation character(len=16) :: aggr_alg ! aggregation algorithm (currently only decoupled) character(len=16) :: mltype ! additive or multiplicative multi-level prec @@ -67,13 +67,13 @@ program df_sample character(len=16) :: cmat ! coarse mat: distributed, replicated character(len=16) :: csolve ! coarse solver: bjac, umf, slu, sludist character(len=16) :: csbsolve ! coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK - integer :: cfill ! fillin for coarse factorization + integer(psb_ipk_) :: cfill ! fillin for coarse factorization real(psb_dpk_) :: cthres ! threshold for coarse fact. ILU(T) - integer :: cjswp ! block-Jacobi sweeps + integer(psb_ipk_) :: cjswp ! block-Jacobi sweeps real(psb_dpk_) :: athres ! smoothed aggregation threshold logical :: dump ! Dump preconditioner on file end type precdata - type(precdata) :: prec_choice + type(precdata) :: prec_choice ! sparse matrices type(psb_dspmat_type) :: a, aux_a @@ -90,26 +90,26 @@ program df_sample ! communications data structure type(psb_desc_type):: desc_a - integer :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np ! solver paramters - integer :: iter, itmax, ierr, itrace, ircode, ipart,& + integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& & methd, istopc, irst, nlv integer(psb_long_int_k_) :: amatsize, precsize, descsize - real(psb_dpk_) :: err, eps + real(psb_dpk_) :: err, eps - character(len=5) :: afmt - character(len=20) :: name - integer, parameter :: iunit=12 - integer :: iparm(20) + character(len=5) :: afmt + character(len=20) :: name + integer(psb_ipk_), parameter :: iunit=12 + integer(psb_ipk_) :: iparm(20) ! other variables - integer :: i,info,j,m_problem - integer :: internal, m,ii,nnzero - real(psb_dpk_) :: t1, t2, tprec - real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp - integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer(psb_ipk_) :: i,info,j,m_problem + integer(psb_ipk_) :: internal, m,ii,nnzero + real(psb_dpk_) :: t1, t2, tprec + real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp + integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) call psb_init(ictxt) call psb_info(ictxt,iam,np) @@ -124,7 +124,7 @@ program df_sample name='df_sample' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -173,7 +173,7 @@ program df_sample call psb_bcast(ictxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,dim=1) == m_problem) then + if (psb_size(aux_b,dim=ione) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) @@ -316,7 +316,7 @@ program df_sample resmx = psb_genrm2(r_col,desc_a,info) resmxp = psb_geamax(r_col,desc_a,info) if (prec_choice%dump) & - & call prec%dump(info,istart=1,prefix="out-"//trim(prec_choice%solve),& + & call prec%dump(info,istart=ione,prefix="out-"//trim(prec_choice%solve),& & solver=.true.) amatsize = a%sizeof() @@ -388,52 +388,52 @@ contains use psb_base_mod implicit none - integer :: icontxt + integer(psb_ipk_) :: icontxt character(len=*) :: kmethd, mtrx, rhs, afmt,filefmt type(precdata) :: prec real(psb_dpk_) :: eps - integer :: iret, istopc,itmax,itrace, ipart, irst - integer :: iam, nm, np, i + integer(psb_ipk_) :: iret, istopc,itmax,itrace, ipart, irst + integer(psb_ipk_) :: iam, nm, np, i call psb_info(icontxt,iam,np) if (iam == psb_root_) then ! read input parameters - call read_data(mtrx,5) - call read_data(rhs,5) - call read_data(filefmt,5) - call read_data(kmethd,5) - call read_data(afmt,5) - call read_data(ipart,5) - call read_data(istopc,5) - call read_data(itmax,5) - call read_data(itrace,5) - call read_data(irst,5) - call read_data(eps,5) - call read_data(prec%dump,5) ! dump prec on file - call read_data(prec%descr,5) ! verbose description of the prec - call read_data(prec%prec,5) ! overall prectype - call read_data(prec%novr,5) ! number of overlap layers - call read_data(prec%restr,5) ! restriction over application of as - call read_data(prec%prol,5) ! prolongation over application of as - call read_data(prec%solve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%fill,5) ! Fill-in for factorization - call read_data(prec%thr,5) ! Threshold for fact. ILU(T) - call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC + call read_data(mtrx,psb_inp_unit) + call read_data(rhs,psb_inp_unit) + call read_data(filefmt,psb_inp_unit) + call read_data(kmethd,psb_inp_unit) + call read_data(afmt,psb_inp_unit) + call read_data(ipart,psb_inp_unit) + call read_data(istopc,psb_inp_unit) + call read_data(itmax,psb_inp_unit) + call read_data(itrace,psb_inp_unit) + call read_data(irst,psb_inp_unit) + call read_data(eps,psb_inp_unit) + call read_data(prec%dump,psb_inp_unit) ! dump prec on file + call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec + call read_data(prec%prec,psb_inp_unit) ! overall prectype + call read_data(prec%novr,psb_inp_unit) ! number of overlap layers + call read_data(prec%restr,psb_inp_unit) ! restriction over application of as + call read_data(prec%prol,psb_inp_unit) ! prolongation over application of as + call read_data(prec%solve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%fill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%thr,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%jsweeps,psb_inp_unit) ! Jacobi sweeps for PJAC if (psb_toupper(prec%prec) == 'ML') then - call read_data(prec%nlev,5) ! Number of levels in multilevel prec. - call read_data(prec%smther,5) ! Smoother type. - call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin - call read_data(prec%aggr_alg,5) ! local or global aggregation - call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec - call read_data(prec%smthpos,5) ! side: pre, post, both smoothing - call read_data(prec%cmat,5) ! coarse mat - call read_data(prec%csolve,5) ! Factorization type: BJAC, SuperLU, UMFPACK. - call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%cfill,5) ! Fill-in for factorization - call read_data(prec%cthres,5) ! Threshold for fact. ILU(T) - call read_data(prec%cjswp,5) ! Jacobi sweeps - call read_data(prec%athres,5) ! smoother aggr thresh + call read_data(prec%nlev,psb_inp_unit) ! Number of levels in multilevel prec. + call read_data(prec%smther,psb_inp_unit) ! Smoother type. + call read_data(prec%aggrkind,psb_inp_unit) ! smoothed/raw aggregatin + call read_data(prec%aggr_alg,psb_inp_unit) ! local or global aggregation + call read_data(prec%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec + call read_data(prec%smthpos,psb_inp_unit) ! side: pre, post, both smoothing + call read_data(prec%cmat,psb_inp_unit) ! coarse mat + call read_data(prec%csolve,psb_inp_unit) ! Factorization type: BJAC, SuperLU, UMFPACK. + call read_data(prec%csbsolve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%cfill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%cthres,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%cjswp,psb_inp_unit) ! Jacobi sweeps + call read_data(prec%athres,psb_inp_unit) ! smoother aggr thresh end if end if @@ -477,7 +477,7 @@ contains end subroutine get_parms subroutine pr_usage(iout) - integer iout + integer(psb_ipk_) iout write(iout, *) ' number of parameters is incorrect!' write(iout, *) ' use: hb_sample mtrx_file methd prec [ptype & &itmax istopc itrace]' diff --git a/tests/fileread/runs/dfs.inp b/tests/fileread/runs/dfs.inp index 7df11c0a..2a9bb463 100644 --- a/tests/fileread/runs/dfs.inp +++ b/tests/fileread/runs/dfs.inp @@ -32,4 +32,3 @@ UMF ! Coarsest-level subsolver: ILU UMF SLU SLUDIST (DSC 4 ! Number of Jacobi sweeps for BJAC/PJAC coarsest-level solver 0.01d0 ! Smoothed aggregation threshold: >= 0.0 F ! dump preconditioner data. - diff --git a/tests/fileread/sf_sample.f90 b/tests/fileread/sf_sample.f90 index c2c91254..c894e07a 100644 --- a/tests/fileread/sf_sample.f90 +++ b/tests/fileread/sf_sample.f90 @@ -51,15 +51,15 @@ program sf_sample type precdata character(len=20) :: descr ! verbose description of the prec character(len=10) :: prec ! overall prectype - integer :: novr ! number of overlap layers - integer :: jsweeps ! Jacobi/smoother sweeps + integer(psb_ipk_) :: novr ! number of overlap layers + integer(psb_ipk_) :: jsweeps ! Jacobi/smoother sweeps character(len=16) :: restr ! restriction over application of AS character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! factorization type: ILU, SuperLU, UMFPACK - integer :: fill ! fillin for factorization + integer(psb_ipk_) :: fill ! fillin for factorization real(psb_spk_) :: thr ! threshold for fact. ILU(T) character(len=16) :: smther ! Smoother - integer :: nlev ! number of levels in multilevel prec. + integer(psb_ipk_) :: nlev ! number of levels in multilevel prec. character(len=16) :: aggrkind ! smoothed, raw aggregation character(len=16) :: aggr_alg ! aggregation algorithm (currently only decoupled) character(len=16) :: mltype ! additive or multiplicative multi-level prec @@ -67,12 +67,12 @@ program sf_sample character(len=16) :: cmat ! coarse mat: distributed, replicated character(len=16) :: csolve ! coarse solver: bjac, umf, slu, sludist character(len=16) :: csbsolve ! coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK - integer :: cfill ! fillin for coarse factorization + integer(psb_ipk_) :: cfill ! fillin for coarse factorization real(psb_spk_) :: cthres ! threshold for coarse fact. ILU(T) - integer :: cjswp ! block-Jacobi sweeps + integer(psb_ipk_) :: cjswp ! block-Jacobi sweeps real(psb_spk_) :: athres ! smoothed aggregation threshold end type precdata - type(precdata) :: prec_choice + type(precdata) :: prec_choice ! sparse matrices type(psb_sspmat_type) :: a, aux_a @@ -89,26 +89,26 @@ program sf_sample ! communications data structure type(psb_desc_type):: desc_a - integer :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np ! solver paramters - integer :: iter, itmax, ierr, itrace, ircode, ipart,& + integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& & methd, istopc, irst, nlv integer(psb_long_int_k_) :: amatsize, precsize, descsize - real(psb_spk_) :: err, eps + real(psb_spk_) :: err, eps - character(len=5) :: afmt - character(len=20) :: name - integer, parameter :: iunit=12 - integer :: iparm(20) + character(len=5) :: afmt + character(len=20) :: name + integer(psb_ipk_), parameter :: iunit=12 + integer(psb_ipk_) :: iparm(20) ! other variables - integer :: i,info,j,m_problem - integer :: internal, m,ii,nnzero - real(psb_dpk_) :: t1, t2, tprec - real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp - integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer(psb_ipk_) :: i,info,j,m_problem + integer(psb_ipk_) :: internal, m,ii,nnzero + real(psb_dpk_) :: t1, t2, tprec + real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp + integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) call psb_init(ictxt) call psb_info(ictxt,iam,np) @@ -123,7 +123,7 @@ program sf_sample name='sf_sample' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -172,7 +172,7 @@ program sf_sample call psb_bcast(ictxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,dim=1) == m_problem) then + if (psb_size(aux_b,dim=ione) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) @@ -384,51 +384,51 @@ contains use psb_base_mod implicit none - integer :: icontxt + integer(psb_ipk_) :: icontxt character(len=*) :: kmethd, mtrx, rhs, afmt,filefmt type(precdata) :: prec real(psb_spk_) :: eps - integer :: iret, istopc,itmax,itrace, ipart, irst - integer :: iam, nm, np, i + integer(psb_ipk_) :: iret, istopc,itmax,itrace, ipart, irst + integer(psb_ipk_) :: iam, nm, np, i call psb_info(icontxt,iam,np) if (iam == psb_root_) then ! read input parameters - call read_data(mtrx,5) - call read_data(rhs,5) - call read_data(filefmt,5) - call read_data(kmethd,5) - call read_data(afmt,5) - call read_data(ipart,5) - call read_data(istopc,5) - call read_data(itmax,5) - call read_data(itrace,5) - call read_data(irst,5) - call read_data(eps,5) - call read_data(prec%descr,5) ! verbose description of the prec - call read_data(prec%prec,5) ! overall prectype - call read_data(prec%novr,5) ! number of overlap layers - call read_data(prec%restr,5) ! restriction over application of as - call read_data(prec%prol,5) ! prolongation over application of as - call read_data(prec%solve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%fill,5) ! Fill-in for factorization - call read_data(prec%thr,5) ! Threshold for fact. ILU(T) - call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC + call read_data(mtrx,psb_inp_unit) + call read_data(rhs,psb_inp_unit) + call read_data(filefmt,psb_inp_unit) + call read_data(kmethd,psb_inp_unit) + call read_data(afmt,psb_inp_unit) + call read_data(ipart,psb_inp_unit) + call read_data(istopc,psb_inp_unit) + call read_data(itmax,psb_inp_unit) + call read_data(itrace,psb_inp_unit) + call read_data(irst,psb_inp_unit) + call read_data(eps,psb_inp_unit) + call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec + call read_data(prec%prec,psb_inp_unit) ! overall prectype + call read_data(prec%novr,psb_inp_unit) ! number of overlap layers + call read_data(prec%restr,psb_inp_unit) ! restriction over application of as + call read_data(prec%prol,psb_inp_unit) ! prolongation over application of as + call read_data(prec%solve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%fill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%thr,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%jsweeps,psb_inp_unit) ! Jacobi sweeps for PJAC if (psb_toupper(prec%prec) == 'ML') then - call read_data(prec%nlev,5) ! Number of levels in multilevel prec. - call read_data(prec%smther,5) ! Smoother type. - call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin - call read_data(prec%aggr_alg,5) ! local or global aggregation - call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec - call read_data(prec%smthpos,5) ! side: pre, post, both smoothing - call read_data(prec%cmat,5) ! coarse mat - call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%cfill,5) ! Fill-in for factorization - call read_data(prec%cthres,5) ! Threshold for fact. ILU(T) - call read_data(prec%cjswp,5) ! Jacobi sweeps - call read_data(prec%athres,5) ! smoother aggr thresh + call read_data(prec%nlev,psb_inp_unit) ! Number of levels in multilevel prec. + call read_data(prec%smther,psb_inp_unit) ! Smoother type. + call read_data(prec%aggrkind,psb_inp_unit) ! smoothed/raw aggregatin + call read_data(prec%aggr_alg,psb_inp_unit) ! local or global aggregation + call read_data(prec%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec + call read_data(prec%smthpos,psb_inp_unit) ! side: pre, post, both smoothing + call read_data(prec%cmat,psb_inp_unit) ! coarse mat + call read_data(prec%csolve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%csbsolve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%cfill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%cthres,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%cjswp,psb_inp_unit) ! Jacobi sweeps + call read_data(prec%athres,psb_inp_unit) ! smoother aggr thresh end if end if @@ -471,7 +471,7 @@ contains end subroutine get_parms subroutine pr_usage(iout) - integer iout + integer(psb_ipk_) iout write(iout, *) ' number of parameters is incorrect!' write(iout, *) ' use: hb_sample mtrx_file methd prec [ptype & &itmax istopc itrace]' diff --git a/tests/fileread/zf_sample.f90 b/tests/fileread/zf_sample.f90 index cd258b87..86078d22 100644 --- a/tests/fileread/zf_sample.f90 +++ b/tests/fileread/zf_sample.f90 @@ -51,15 +51,15 @@ program zf_sample type precdata character(len=20) :: descr ! verbose description of the prec character(len=10) :: prec ! overall prectype - integer :: novr ! number of overlap layers - integer :: jsweeps ! Jacobi/smoother sweeps + integer(psb_ipk_) :: novr ! number of overlap layers + integer(psb_ipk_) :: jsweeps ! Jacobi/smoother sweeps character(len=16) :: restr ! restriction over application of AS character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! factorization type: ILU, SuperLU, UMFPACK - integer :: fill ! fillin for factorization + integer(psb_ipk_) :: fill ! fillin for factorization real(psb_dpk_) :: thr ! threshold for fact. ILU(T) character(len=16) :: smther ! Smoother - integer :: nlev ! number of levels in multilevel prec. + integer(psb_ipk_) :: nlev ! number of levels in multilevel prec. character(len=16) :: aggrkind ! smoothed, raw aggregation character(len=16) :: aggr_alg ! aggregation algorithm (currently only decoupled) character(len=16) :: mltype ! additive or multiplicative multi-level prec @@ -67,12 +67,12 @@ program zf_sample character(len=16) :: cmat ! coarse mat: distributed, replicated character(len=16) :: csolve ! coarse solver: bjac, umf, slu, sludist character(len=16) :: csbsolve ! coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK - integer :: cfill ! fillin for coarse factorization + integer(psb_ipk_) :: cfill ! fillin for coarse factorization real(psb_dpk_) :: cthres ! threshold for coarse fact. ILU(T) - integer :: cjswp ! block-Jacobi sweeps + integer(psb_ipk_) :: cjswp ! block-Jacobi sweeps real(psb_dpk_) :: athres ! smoothed aggregation threshold end type precdata - type(precdata) :: prec_choice + type(precdata) :: prec_choice ! sparse matrices type(psb_zspmat_type) :: a, aux_a @@ -89,26 +89,26 @@ program zf_sample ! communications data structure type(psb_desc_type):: desc_a - integer :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np ! solver paramters - integer :: iter, itmax, ierr, itrace, ircode, ipart,& + integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& & methd, istopc, irst, nlv integer(psb_long_int_k_) :: amatsize, precsize, descsize - real(psb_dpk_) :: err, eps + real(psb_dpk_) :: err, eps character(len=5) :: afmt character(len=20) :: name - integer, parameter :: iunit=12 - integer :: iparm(20) + integer(psb_ipk_), parameter :: iunit=12 + integer(psb_ipk_) :: iparm(20) ! other variables - integer :: i,info,j,m_problem - integer :: internal, m,ii,nnzero - real(psb_dpk_) :: t1, t2, tprec - real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp - integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer(psb_ipk_) :: i,info,j,m_problem + integer(psb_ipk_) :: internal, m,ii,nnzero + real(psb_dpk_) :: t1, t2, tprec + real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp + integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) call psb_init(ictxt) call psb_info(ictxt,iam,np) @@ -123,7 +123,7 @@ program zf_sample name='df_sample' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -172,7 +172,7 @@ program zf_sample call psb_bcast(ictxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,dim=1) == m_problem) then + if (psb_size(aux_b,dim=ione) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) @@ -384,51 +384,51 @@ contains use psb_base_mod implicit none - integer :: icontxt + integer(psb_ipk_) :: icontxt character(len=*) :: kmethd, mtrx, rhs, afmt,filefmt type(precdata) :: prec real(psb_dpk_) :: eps - integer :: iret, istopc,itmax,itrace, ipart, irst - integer :: iam, nm, np, i + integer(psb_ipk_) :: iret, istopc,itmax,itrace, ipart, irst + integer(psb_ipk_) :: iam, nm, np, i call psb_info(icontxt,iam,np) if (iam == psb_root_) then ! read input parameters - call read_data(mtrx,5) - call read_data(rhs,5) - call read_data(filefmt,5) - call read_data(kmethd,5) - call read_data(afmt,5) - call read_data(ipart,5) - call read_data(istopc,5) - call read_data(itmax,5) - call read_data(itrace,5) - call read_data(irst,5) - call read_data(eps,5) - call read_data(prec%descr,5) ! verbose description of the prec - call read_data(prec%prec,5) ! overall prectype - call read_data(prec%novr,5) ! number of overlap layers - call read_data(prec%restr,5) ! restriction over application of as - call read_data(prec%prol,5) ! prolongation over application of as - call read_data(prec%solve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%fill,5) ! Fill-in for factorization - call read_data(prec%thr,5) ! Threshold for fact. ILU(T) - call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC + call read_data(mtrx,psb_inp_unit) + call read_data(rhs,psb_inp_unit) + call read_data(filefmt,psb_inp_unit) + call read_data(kmethd,psb_inp_unit) + call read_data(afmt,psb_inp_unit) + call read_data(ipart,psb_inp_unit) + call read_data(istopc,psb_inp_unit) + call read_data(itmax,psb_inp_unit) + call read_data(itrace,psb_inp_unit) + call read_data(irst,psb_inp_unit) + call read_data(eps,psb_inp_unit) + call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec + call read_data(prec%prec,psb_inp_unit) ! overall prectype + call read_data(prec%novr,psb_inp_unit) ! number of overlap layers + call read_data(prec%restr,psb_inp_unit) ! restriction over application of as + call read_data(prec%prol,psb_inp_unit) ! prolongation over application of as + call read_data(prec%solve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%fill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%thr,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%jsweeps,psb_inp_unit) ! Jacobi sweeps for PJAC if (psb_toupper(prec%prec) == 'ML') then - call read_data(prec%nlev,5) ! Number of levels in multilevel prec. - call read_data(prec%smther,5) ! Smoother type. - call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin - call read_data(prec%aggr_alg,5) ! local or global aggregation - call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec - call read_data(prec%smthpos,5) ! side: pre, post, both smoothing - call read_data(prec%cmat,5) ! coarse mat - call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. - call read_data(prec%cfill,5) ! Fill-in for factorization - call read_data(prec%cthres,5) ! Threshold for fact. ILU(T) - call read_data(prec%cjswp,5) ! Jacobi sweeps - call read_data(prec%athres,5) ! smoother aggr thresh + call read_data(prec%nlev,psb_inp_unit) ! Number of levels in multilevel prec. + call read_data(prec%smther,psb_inp_unit) ! Smoother type. + call read_data(prec%aggrkind,psb_inp_unit) ! smoothed/raw aggregatin + call read_data(prec%aggr_alg,psb_inp_unit) ! local or global aggregation + call read_data(prec%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec + call read_data(prec%smthpos,psb_inp_unit) ! side: pre, post, both smoothing + call read_data(prec%cmat,psb_inp_unit) ! coarse mat + call read_data(prec%csolve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%csbsolve,psb_inp_unit) ! Factorization type: ILU, SuperLU, UMFPACK. + call read_data(prec%cfill,psb_inp_unit) ! Fill-in for factorization + call read_data(prec%cthres,psb_inp_unit) ! Threshold for fact. ILU(T) + call read_data(prec%cjswp,psb_inp_unit) ! Jacobi sweeps + call read_data(prec%athres,psb_inp_unit) ! smoother aggr thresh end if end if @@ -471,7 +471,7 @@ contains end subroutine get_parms subroutine pr_usage(iout) - integer iout + integer(psb_ipk_) iout write(iout, *) ' number of parameters is incorrect!' write(iout, *) ' use: hb_sample mtrx_file methd prec [ptype & &itmax istopc itrace]' diff --git a/tests/pdegen/data_input.f90 b/tests/pdegen/data_input.f90 index ff25fc4f..b32ee0f5 100644 --- a/tests/pdegen/data_input.f90 +++ b/tests/pdegen/data_input.f90 @@ -41,9 +41,10 @@ module data_input interface read_data module procedure read_char, read_int,& - & read_double, read_single,& + & read_double, read_single, read_logical,& & string_read_char, string_read_int,& - & string_read_double, string_read_single + & string_read_double, string_read_single, & + & string_read_logical end interface read_data interface trim_string module procedure trim_string @@ -54,6 +55,16 @@ module data_input contains + subroutine read_logical(val,file,marker) + logical, intent(out) :: val + integer(psb_ipk_), intent(in) :: file + character(len=1), optional, intent(in) :: marker + + read(file,'(a)')charbuf + call read_data(val,charbuf,marker) + + end subroutine read_logical + subroutine read_char(val,file,marker) character(len=*), intent(out) :: val integer(psb_ipk_), intent(in) :: file @@ -129,6 +140,7 @@ contains if (idx == 0) idx = len(charbuf)+1 read(charbuf(1:idx-1),*) val end subroutine string_read_int + subroutine string_read_single(val,file,marker) real(psb_spk_), intent(out) :: val character(len=*), intent(in) :: file @@ -147,6 +159,7 @@ contains if (idx == 0) idx = len(charbuf)+1 read(charbuf(1:idx-1),*) val end subroutine string_read_single + subroutine string_read_double(val,file,marker) real(psb_dpk_), intent(out) :: val character(len=*), intent(in) :: file @@ -166,6 +179,25 @@ contains read(charbuf(1:idx-1),*) val end subroutine string_read_double + subroutine string_read_logical(val,file,marker) + logical, intent(out) :: val + character(len=*), intent(in) :: file + character(len=1), optional, intent(in) :: marker + character(len=1) :: marker_ + character(len=1024) :: charbuf + integer(psb_ipk_) :: idx + if (present(marker)) then + marker_ = marker + else + marker_ = def_marker + end if + read(file,'(a)')charbuf + charbuf = adjustl(charbuf) + idx=index(charbuf,marker_) + if (idx == 0) idx = len(charbuf)+1 + read(charbuf(1:idx-1),*) val + end subroutine string_read_logical + function trim_string(string,marker) character(len=*), intent(in) :: string character(len=1), optional, intent(in) :: marker diff --git a/tests/pdegen/ppde2d.f90 b/tests/pdegen/ppde2d.f90 index 481e930f..7de1a769 100644 --- a/tests/pdegen/ppde2d.f90 +++ b/tests/pdegen/ppde2d.f90 @@ -259,6 +259,7 @@ program ppde2d call mld_precset(prec,mld_sub_fillin_, prectype%fill1, info) call mld_precset(prec,mld_sub_iluthrs_, prectype%thr1, info) end if + call psb_barrier(ictxt) t1 = psb_wtime() call mld_precbld(a,desc_a,prec,info) diff --git a/tests/pdegen/runs/ppde.inp b/tests/pdegen/runs/ppde.inp index eec63fdd..ed156384 100644 --- a/tests/pdegen/runs/ppde.inp +++ b/tests/pdegen/runs/ppde.inp @@ -1,6 +1,6 @@ BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG CSR ! Storage format CSR COO JAD -040 ! IDIM; domain size is idim**3 +080 ! IDIM; domain size is idim**3 2 ! ISTOPC 0100 ! ITMAX -1 ! ITRACE