diff --git a/mlprec/impl/mld_c_dec_map_bld.F90 b/mlprec/impl/mld_c_dec_map_bld.f90 similarity index 72% rename from mlprec/impl/mld_c_dec_map_bld.F90 rename to mlprec/impl/mld_c_dec_map_bld.f90 index c503d46b..9bd8f43b 100644 --- a/mlprec/impl/mld_c_dec_map_bld.F90 +++ b/mlprec/impl/mld_c_dec_map_bld.f90 @@ -1,3 +1,41 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) @@ -10,18 +48,18 @@ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a real(psb_spk_), intent(in) :: theta - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:), irow(:), icol(:) + integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:) complex(psb_spk_), allocatable :: val(:), diag(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz real(psb_spk_) :: cpling, tcl logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if (psb_get_errstatus() /= 0) return @@ -40,7 +78,7 @@ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ilaggr(nr),neigh(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -48,7 +86,7 @@ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(diag(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -106,7 +144,7 @@ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) ! ! 2. Untouched neighbours of these nodes are marked <0. ! - call a%get_neigh(i,neigh,n_ne,info,lev=2) + call a%get_neigh(i,neigh,n_ne,info,lev=2_psb_ipk_) if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_neigh') @@ -135,7 +173,7 @@ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ils(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/naggr+10,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -276,7 +314,7 @@ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(nlaggr(np),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/np,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/np,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if diff --git a/mlprec/impl/mld_caggrmap_bld.f90 b/mlprec/impl/mld_caggrmap_bld.f90 index 71cb87bb..2e7722bd 100644 --- a/mlprec/impl/mld_caggrmap_bld.f90 +++ b/mlprec/impl/mld_caggrmap_bld.f90 @@ -87,21 +87,21 @@ subroutine mld_caggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) implicit none ! Arguments - integer, intent(in) :: aggr_type + integer(psb_ipk_), intent(in) :: aggr_type real(psb_spk_), intent(in) :: theta type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m + integer(psb_ipk_), allocatable :: ils(:), neigh(:) + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m type(psb_cspmat_type) :: atmp, atrans logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if(psb_get_errstatus() /= 0) return @@ -133,13 +133,14 @@ subroutine mld_caggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) call atmp%set_ncols(nr) if (info == psb_success_) call atrans%free() if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) + if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) if (info == psb_success_) call atmp%free() case default info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/1,aggr_type,0,0,0/)) + call psb_errpush(psb_err_input_value_invalid_i_,name,& + & i_err=(/ione,aggr_type,izero,izero,izero/)) goto 9999 end select diff --git a/mlprec/impl/mld_cmlprec_aply.f90 b/mlprec/impl/mld_cmlprec_aply.f90 index 31439544..9e0232e9 100644 --- a/mlprec/impl/mld_cmlprec_aply.f90 +++ b/mlprec/impl/mld_cmlprec_aply.f90 @@ -364,7 +364,8 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/size(x)+size(y),0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -446,7 +447,7 @@ contains & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -741,7 +742,7 @@ contains allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -831,7 +832,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -839,7 +840,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select @@ -925,7 +926,7 @@ subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then nc2l = p%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -954,7 +955,7 @@ subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ nc2l = p%precv(level)%base_desc%get_local_cols() - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -1394,7 +1395,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -1402,7 +1403,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select diff --git a/mlprec/impl/mld_d_dec_map_bld.F90 b/mlprec/impl/mld_d_dec_map_bld.f90 similarity index 72% rename from mlprec/impl/mld_d_dec_map_bld.F90 rename to mlprec/impl/mld_d_dec_map_bld.f90 index 636c9dcb..2ffb150f 100644 --- a/mlprec/impl/mld_d_dec_map_bld.F90 +++ b/mlprec/impl/mld_d_dec_map_bld.f90 @@ -1,3 +1,41 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) @@ -10,18 +48,18 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_), intent(in) :: theta - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:), irow(:), icol(:) + integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:) real(psb_dpk_), allocatable :: val(:), diag(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz real(psb_dpk_) :: cpling, tcl logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if (psb_get_errstatus() /= 0) return @@ -40,7 +78,7 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ilaggr(nr),neigh(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -48,7 +86,7 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(diag(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -106,7 +144,7 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) ! ! 2. Untouched neighbours of these nodes are marked <0. ! - call a%get_neigh(i,neigh,n_ne,info,lev=2) + call a%get_neigh(i,neigh,n_ne,info,lev=2_psb_ipk_) if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_neigh') @@ -135,7 +173,7 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ils(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/naggr+10,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -172,7 +210,7 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) ! isz = nr+1 ia = -1 - cpling = dzero + cpling = szero call a%csget(i,i,nz,irow,icol,val,info) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -276,7 +314,7 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(nlaggr(np),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/np,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/np,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if diff --git a/mlprec/impl/mld_daggrmap_bld.f90 b/mlprec/impl/mld_daggrmap_bld.f90 index 3981ae33..2b909fb2 100644 --- a/mlprec/impl/mld_daggrmap_bld.f90 +++ b/mlprec/impl/mld_daggrmap_bld.f90 @@ -87,21 +87,21 @@ subroutine mld_daggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) implicit none ! Arguments - integer, intent(in) :: aggr_type + integer(psb_ipk_), intent(in) :: aggr_type real(psb_dpk_), intent(in) :: theta - type(psb_dspmat_type), intent(in) :: a + type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m + integer(psb_ipk_), allocatable :: ils(:), neigh(:) + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m type(psb_dspmat_type) :: atmp, atrans logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if(psb_get_errstatus() /= 0) return @@ -133,13 +133,14 @@ subroutine mld_daggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) call atmp%set_ncols(nr) if (info == psb_success_) call atrans%free() if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) + if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) if (info == psb_success_) call atmp%free() case default info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/1,aggr_type,0,0,0/)) + call psb_errpush(psb_err_input_value_invalid_i_,name,& + & i_err=(/ione,aggr_type,izero,izero,izero/)) goto 9999 end select diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 93cce43b..e99d89a3 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -364,7 +364,8 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/size(x)+size(y),0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -446,7 +447,7 @@ contains & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -741,7 +742,7 @@ contains allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -831,7 +832,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -839,7 +840,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select @@ -925,7 +926,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then nc2l = p%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -954,7 +955,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ nc2l = p%precv(level)%base_desc%get_local_cols() - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -1394,7 +1395,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -1402,7 +1403,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select diff --git a/mlprec/impl/mld_s_dec_map_bld.F90 b/mlprec/impl/mld_s_dec_map_bld.f90 similarity index 72% rename from mlprec/impl/mld_s_dec_map_bld.F90 rename to mlprec/impl/mld_s_dec_map_bld.f90 index 78d0b961..209bdd05 100644 --- a/mlprec/impl/mld_s_dec_map_bld.F90 +++ b/mlprec/impl/mld_s_dec_map_bld.f90 @@ -1,3 +1,41 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) @@ -10,18 +48,18 @@ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a real(psb_spk_), intent(in) :: theta - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:), irow(:), icol(:) + integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:) real(psb_spk_), allocatable :: val(:), diag(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz real(psb_spk_) :: cpling, tcl logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if (psb_get_errstatus() /= 0) return @@ -40,7 +78,7 @@ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ilaggr(nr),neigh(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -48,7 +86,7 @@ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(diag(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -106,7 +144,7 @@ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) ! ! 2. Untouched neighbours of these nodes are marked <0. ! - call a%get_neigh(i,neigh,n_ne,info,lev=2) + call a%get_neigh(i,neigh,n_ne,info,lev=2_psb_ipk_) if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_neigh') @@ -135,7 +173,7 @@ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ils(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/naggr+10,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -276,7 +314,7 @@ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(nlaggr(np),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/np,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/np,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if diff --git a/mlprec/impl/mld_saggrmap_bld.f90 b/mlprec/impl/mld_saggrmap_bld.f90 index 743f4653..4fc748b0 100644 --- a/mlprec/impl/mld_saggrmap_bld.f90 +++ b/mlprec/impl/mld_saggrmap_bld.f90 @@ -87,21 +87,21 @@ subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) implicit none ! Arguments - integer, intent(in) :: aggr_type + integer(psb_ipk_), intent(in) :: aggr_type real(psb_spk_), intent(in) :: theta - type(psb_sspmat_type), intent(in) :: a + type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m + integer(psb_ipk_), allocatable :: ils(:), neigh(:) + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m type(psb_sspmat_type) :: atmp, atrans logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if(psb_get_errstatus() /= 0) return @@ -133,13 +133,14 @@ subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) call atmp%set_ncols(nr) if (info == psb_success_) call atrans%free() if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) + if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) if (info == psb_success_) call atmp%free() case default info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/1,aggr_type,0,0,0/)) + call psb_errpush(psb_err_input_value_invalid_i_,name,& + & i_err=(/ione,aggr_type,izero,izero,izero/)) goto 9999 end select diff --git a/mlprec/impl/mld_smlprec_aply.f90 b/mlprec/impl/mld_smlprec_aply.f90 index 1258f339..9aceeff0 100644 --- a/mlprec/impl/mld_smlprec_aply.f90 +++ b/mlprec/impl/mld_smlprec_aply.f90 @@ -364,7 +364,8 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/size(x)+size(y),0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -446,7 +447,7 @@ contains & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -741,7 +742,7 @@ contains allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -831,7 +832,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -839,7 +840,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select @@ -925,7 +926,7 @@ subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then nc2l = p%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -954,7 +955,7 @@ subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ nc2l = p%precv(level)%base_desc%get_local_cols() - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -1394,7 +1395,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -1402,7 +1403,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select diff --git a/mlprec/impl/mld_z_dec_map_bld.F90 b/mlprec/impl/mld_z_dec_map_bld.f90 similarity index 72% rename from mlprec/impl/mld_z_dec_map_bld.F90 rename to mlprec/impl/mld_z_dec_map_bld.f90 index 8807bffd..1e7a1a59 100644 --- a/mlprec/impl/mld_z_dec_map_bld.F90 +++ b/mlprec/impl/mld_z_dec_map_bld.f90 @@ -1,3 +1,41 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) @@ -10,18 +48,18 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_), intent(in) :: theta - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:), irow(:), icol(:) + integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:) complex(psb_dpk_), allocatable :: val(:), diag(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz real(psb_dpk_) :: cpling, tcl logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if (psb_get_errstatus() /= 0) return @@ -40,7 +78,7 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ilaggr(nr),neigh(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -48,7 +86,7 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(diag(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/nr,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -106,7 +144,7 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) ! ! 2. Untouched neighbours of these nodes are marked <0. ! - call a%get_neigh(i,neigh,n_ne,info,lev=2) + call a%get_neigh(i,neigh,n_ne,info,lev=2_psb_ipk_) if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_neigh') @@ -135,7 +173,7 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(ils(nr),stat=info) if(info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/naggr+10,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if @@ -172,7 +210,7 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) ! isz = nr+1 ia = -1 - cpling = dzero + cpling = szero call a%csget(i,i,nz,irow,icol,val,info) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -276,7 +314,7 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) allocate(nlaggr(np),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/np,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/np,izero,izero,izero,izero/),& & a_err='integer') goto 9999 end if diff --git a/mlprec/impl/mld_zaggrmap_bld.f90 b/mlprec/impl/mld_zaggrmap_bld.f90 index 14fd7396..f3ccdc03 100644 --- a/mlprec/impl/mld_zaggrmap_bld.f90 +++ b/mlprec/impl/mld_zaggrmap_bld.f90 @@ -87,21 +87,21 @@ subroutine mld_zaggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) implicit none ! Arguments - integer, intent(in) :: aggr_type + integer(psb_ipk_), intent(in) :: aggr_type real(psb_dpk_), intent(in) :: theta type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) - integer, intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + integer(psb_ipk_), intent(out) :: info ! Local variables - integer, allocatable :: ils(:), neigh(:) - integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m + integer(psb_ipk_), allocatable :: ils(:), neigh(:) + integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m type(psb_zspmat_type) :: atmp, atrans logical :: recovery - integer :: debug_level, debug_unit - integer :: ictxt,np,me,err_act - integer :: nrow, ncol, n_ne + integer(psb_ipk_) :: debug_level, debug_unit,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: nrow, ncol, n_ne character(len=20) :: name, ch_err if(psb_get_errstatus() /= 0) return @@ -133,13 +133,14 @@ subroutine mld_zaggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) call atmp%set_ncols(nr) if (info == psb_success_) call atrans%free() if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) + if (info == psb_success_) call mld_dec_map_bld(theta,atmp,desc_a,nlaggr,ilaggr,info) if (info == psb_success_) call atmp%free() case default info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/1,aggr_type,0,0,0/)) + call psb_errpush(psb_err_input_value_invalid_i_,name,& + & i_err=(/ione,aggr_type,izero,izero,izero/)) goto 9999 end select diff --git a/mlprec/impl/mld_zmlprec_aply.f90 b/mlprec/impl/mld_zmlprec_aply.f90 index a37bcd6b..f72bfb5f 100644 --- a/mlprec/impl/mld_zmlprec_aply.f90 +++ b/mlprec/impl/mld_zmlprec_aply.f90 @@ -364,7 +364,8 @@ subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/size(x)+size(y),0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -446,7 +447,7 @@ contains & stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -741,7 +742,7 @@ contains allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -831,7 +832,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -839,7 +840,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select @@ -925,7 +926,7 @@ subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then nc2l = p%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -954,7 +955,7 @@ subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ nc2l = p%precv(level)%base_desc%get_local_cols() - call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -1394,7 +1395,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/p%precv(level)%parms%smoother_pos,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/)) goto 9999 end select @@ -1402,7 +1403,7 @@ contains case default info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/p%precv(level)%parms%ml_type,0,0,0,0/)) + & i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) goto 9999 end select