You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
psblas3/base/serial/psb_sgelp.f90

260 lines
8.0 KiB
Fortran

psblas3: base/Makefile base/comm/psb_cgather.f90 base/comm/psb_chalo.f90 base/comm/psb_covrl.f90 base/comm/psb_dgather.f90 base/comm/psb_dhalo.f90 base/comm/psb_dovrl.f90 base/comm/psb_sgather.f90 base/comm/psb_shalo.f90 base/comm/psb_sovrl.f90 base/comm/psb_zgather.f90 base/comm/psb_zhalo.f90 base/comm/psb_zovrl.f90 base/internals/psi_cswapdata.F90 base/internals/psi_cswaptran.F90 base/internals/psi_dswapdata.F90 base/internals/psi_dswaptran.F90 base/internals/psi_idx_ins_cnv.f90 base/internals/psi_ovrl_restr.f90 base/internals/psi_ovrl_save.f90 base/internals/psi_ovrl_upd.f90 base/internals/psi_sswapdata.F90 base/internals/psi_sswaptran.F90 base/internals/psi_zswapdata.F90 base/internals/psi_zswaptran.F90 base/modules/Makefile base/modules/psb_base_mat_mod.f90 base/modules/psb_base_mod.f90 base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_base_vect_mod.f90 base/modules/psb_c_comm_mod.f90 base/modules/psb_c_csc_mat_mod.f90 base/modules/psb_c_csr_mat_mod.f90 base/modules/psb_c_linmap_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_c_psblas_mod.f90 base/modules/psb_c_tools_mod.f90 base/modules/psb_c_vect_mod.f90 base/modules/psb_check_mod.f90 base/modules/psb_comm_mod.f90 base/modules/psb_const_mod.F90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_base_vect_mod.f90 base/modules/psb_d_comm_mod.f90 base/modules/psb_d_csc_mat_mod.f90 base/modules/psb_d_csr_mat_mod.f90 base/modules/psb_d_linmap_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_d_psblas_mod.f90 base/modules/psb_d_tools_mod.f90 base/modules/psb_d_vect_mod.f90 base/modules/psb_error_impl.F90 base/modules/psb_error_mod.F90 base/modules/psb_i_comm_mod.f90 base/modules/psb_ip_reord_mod.f90 base/modules/psb_linmap_mod.f90 base/modules/psb_linmap_type_mod.f90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_base_vect_mod.f90 base/modules/psb_s_comm_mod.f90 base/modules/psb_s_csc_mat_mod.f90 base/modules/psb_s_csr_mat_mod.f90 base/modules/psb_s_linmap_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_s_psblas_mod.f90 base/modules/psb_s_tools_mod.f90 base/modules/psb_s_vect_mod.f90 base/modules/psb_serial_mod.f90 base/modules/psb_vect_mod.f90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_base_vect_mod.f90 base/modules/psb_z_comm_mod.f90 base/modules/psb_z_csc_mat_mod.f90 base/modules/psb_z_csr_mat_mod.f90 base/modules/psb_z_linmap_mod.f90 base/modules/psb_z_mat_mod.f90 base/modules/psb_z_psblas_mod.f90 base/modules/psb_z_tools_mod.f90 base/modules/psb_z_vect_mod.f90 base/modules/psi_c_mod.f90 base/modules/psi_d_mod.f90 base/modules/psi_i_mod.f90 base/modules/psi_mod.f90 base/modules/psi_penv_mod.F90 base/modules/psi_s_mod.f90 base/modules/psi_z_mod.f90 base/psblas/psb_camax.f90 base/psblas/psb_casum.f90 base/psblas/psb_caxpby.f90 base/psblas/psb_cdot.f90 base/psblas/psb_cnrm2.f90 base/psblas/psb_cspmm.f90 base/psblas/psb_cspsm.f90 base/psblas/psb_damax.f90 base/psblas/psb_dasum.f90 base/psblas/psb_daxpby.f90 base/psblas/psb_ddot.f90 base/psblas/psb_dnrm2.f90 base/psblas/psb_dnrmi.f90 base/psblas/psb_dspmm.f90 base/psblas/psb_dspnrm1.f90 base/psblas/psb_dspsm.f90 base/psblas/psb_samax.f90 base/psblas/psb_sasum.f90 base/psblas/psb_saxpby.f90 base/psblas/psb_sdot.f90 base/psblas/psb_snrm2.f90 base/psblas/psb_sspmm.f90 base/psblas/psb_sspsm.f90 base/psblas/psb_zamax.f90 base/psblas/psb_zasum.f90 base/psblas/psb_zaxpby.f90 base/psblas/psb_zdot.f90 base/psblas/psb_znrm2.f90 base/psblas/psb_zspmm.f90 base/psblas/psb_zspsm.f90 base/serial/Makefile base/serial/impl/psb_c_base_mat_impl.f90 base/serial/impl/psb_c_coo_impl.f90 base/serial/impl/psb_c_csc_impl.f90 base/serial/impl/psb_c_csr_impl.f90 base/serial/impl/psb_c_mat_impl.F90 base/serial/impl/psb_d_base_mat_impl.f90 base/serial/impl/psb_d_coo_impl.f90 base/serial/impl/psb_d_csc_impl.f90 base/serial/impl/psb_d_csr_impl.f90 base/serial/impl/psb_d_mat_impl.F90 base/serial/impl/psb_s_base_mat_impl.f90 base/serial/impl/psb_s_coo_impl.f90 base/serial/impl/psb_s_csc_impl.f90 base/serial/impl/psb_s_csr_impl.f90 base/serial/impl/psb_s_mat_impl.F90 base/serial/impl/psb_z_base_mat_impl.f90 base/serial/impl/psb_z_coo_impl.f90 base/serial/impl/psb_z_csc_impl.f90 base/serial/impl/psb_z_csr_impl.f90 base/serial/impl/psb_z_mat_impl.F90 base/serial/psb_cgelp.f90 base/serial/psb_dgelp.f90 base/serial/psb_sgelp.f90 base/serial/psb_spdot_srtd.f90 base/serial/psb_zgelp.f90 base/tools/Makefile base/tools/psb_c_map.f90 base/tools/psb_callc.f90 base/tools/psb_casb.f90 base/tools/psb_cdins.f90 base/tools/psb_cfree.f90 base/tools/psb_cins.f90 base/tools/psb_d_map.f90 base/tools/psb_dallc.f90 base/tools/psb_dasb.f90 base/tools/psb_dcdbldext.F90 base/tools/psb_dfree.f90 base/tools/psb_dins.f90 base/tools/psb_dspalloc.f90 base/tools/psb_dspasb.f90 base/tools/psb_dspfree.f90 base/tools/psb_dsphalo.F90 base/tools/psb_dspins.f90 base/tools/psb_dsprn.f90 base/tools/psb_linmap.f90 base/tools/psb_map.f90 base/tools/psb_s_map.f90 base/tools/psb_sallc.f90 base/tools/psb_sasb.f90 base/tools/psb_sfree.f90 base/tools/psb_sins.f90 base/tools/psb_z_map.f90 base/tools/psb_zallc.f90 base/tools/psb_zasb.f90 base/tools/psb_zfree.f90 base/tools/psb_zins.f90 config/pac.m4 configure.ac configure docs/html/footnode.html docs/html/img1.png docs/html/img10.png docs/html/img100.png docs/html/img101.png docs/html/img102.png docs/html/img103.png docs/html/img104.png docs/html/img105.png docs/html/img106.png docs/html/img107.png docs/html/img108.png docs/html/img109.png docs/html/img11.png docs/html/img110.png docs/html/img111.png docs/html/img112.png docs/html/img113.png docs/html/img114.png docs/html/img115.png docs/html/img116.png docs/html/img117.png docs/html/img118.png docs/html/img119.png docs/html/img12.png docs/html/img120.png docs/html/img121.png docs/html/img122.png docs/html/img123.png docs/html/img124.png docs/html/img125.png docs/html/img126.png docs/html/img127.png docs/html/img128.png docs/html/img129.png docs/html/img13.png docs/html/img130.png docs/html/img131.png docs/html/img132.png docs/html/img133.png docs/html/img134.png docs/html/img135.png docs/html/img136.png docs/html/img137.png docs/html/img138.png docs/html/img14.png docs/html/img140.png docs/html/img141.png docs/html/img142.png docs/html/img143.png docs/html/img144.png docs/html/img145.png docs/html/img146.png docs/html/img147.png docs/html/img148.png docs/html/img149.png docs/html/img15.png docs/html/img16.png docs/html/img17.png docs/html/img18.png docs/html/img2.png docs/html/img20.png docs/html/img22.png docs/html/img23.png docs/html/img24.png docs/html/img26.png docs/html/img27.png docs/html/img28.png docs/html/img29.png docs/html/img3.png docs/html/img30.png docs/html/img31.png docs/html/img32.png docs/html/img33.png docs/html/img34.png docs/html/img35.png docs/html/img36.png docs/html/img37.png docs/html/img38.png docs/html/img39.png docs/html/img4.png docs/html/img40.png docs/html/img41.png docs/html/img42.png docs/html/img43.png docs/html/img44.png docs/html/img45.png docs/html/img46.png docs/html/img47.png docs/html/img48.png docs/html/img49.png docs/html/img5.png docs/html/img50.png docs/html/img51.png docs/html/img52.png docs/html/img53.png docs/html/img54.png docs/html/img55.png docs/html/img56.png docs/html/img57.png docs/html/img58.png docs/html/img59.png docs/html/img6.png docs/html/img60.png docs/html/img61.png docs/html/img62.png docs/html/img63.png docs/html/img64.png docs/html/img65.png docs/html/img66.png docs/html/img67.png docs/html/img68.png docs/html/img69.png docs/html/img7.png docs/html/img70.png docs/html/img71.png docs/html/img72.png docs/html/img73.png docs/html/img74.png docs/html/img75.png docs/html/img76.png docs/html/img77.png docs/html/img78.png docs/html/img79.png docs/html/img8.png docs/html/img80.png docs/html/img81.png docs/html/img82.png docs/html/img83.png docs/html/img84.png docs/html/img85.png docs/html/img86.png docs/html/img87.png docs/html/img88.png docs/html/img89.png docs/html/img9.png docs/html/img90.png docs/html/img91.png docs/html/img92.png docs/html/img93.png docs/html/img94.png docs/html/img95.png docs/html/img96.png docs/html/img97.png docs/html/img98.png docs/html/img99.png docs/html/index.html docs/html/node1.html docs/html/node10.html docs/html/node100.html docs/html/node101.html docs/html/node102.html docs/html/node103.html docs/html/node104.html docs/html/node105.html docs/html/node106.html docs/html/node107.html docs/html/node108.html docs/html/node109.html docs/html/node11.html docs/html/node12.html docs/html/node13.html docs/html/node14.html docs/html/node15.html docs/html/node16.html docs/html/node17.html docs/html/node18.html docs/html/node19.html docs/html/node2.html docs/html/node20.html docs/html/node21.html docs/html/node22.html docs/html/node23.html docs/html/node24.html docs/html/node25.html docs/html/node26.html docs/html/node27.html docs/html/node28.html docs/html/node29.html docs/html/node3.html docs/html/node30.html docs/html/node31.html docs/html/node32.html docs/html/node33.html docs/html/node34.html docs/html/node35.html docs/html/node36.html docs/html/node37.html docs/html/node38.html docs/html/node39.html docs/html/node4.html docs/html/node40.html docs/html/node41.html docs/html/node42.html docs/html/node43.html docs/html/node44.html docs/html/node45.html docs/html/node46.html docs/html/node47.html docs/html/node48.html docs/html/node49.html docs/html/node5.html docs/html/node50.html docs/html/node51.html docs/html/node52.html docs/html/node53.html docs/html/node54.html docs/html/node55.html docs/html/node56.html docs/html/node57.html docs/html/node58.html docs/html/node59.html docs/html/node6.html docs/html/node60.html docs/html/node61.html docs/html/node62.html docs/html/node63.html docs/html/node64.html docs/html/node65.html docs/html/node66.html docs/html/node67.html docs/html/node68.html docs/html/node69.html docs/html/node7.html docs/html/node70.html docs/html/node71.html docs/html/node72.html docs/html/node73.html docs/html/node74.html docs/html/node75.html docs/html/node76.html docs/html/node77.html docs/html/node78.html docs/html/node79.html docs/html/node8.html docs/html/node80.html docs/html/node81.html docs/html/node82.html docs/html/node83.html docs/html/node84.html docs/html/node85.html docs/html/node86.html docs/html/node87.html docs/html/node88.html docs/html/node89.html docs/html/node9.html docs/html/node90.html docs/html/node91.html docs/html/node92.html docs/html/node93.html docs/html/node94.html docs/html/node95.html docs/html/node96.html docs/html/node97.html docs/html/node98.html docs/html/node99.html docs/html/userhtml.html docs/psblas-3.0.pdf docs/src/datastruct.tex krylov/Makefile krylov/psb_base_inner_krylov_mod.f90 krylov/psb_c_inner_krylov_mod.f90 krylov/psb_cbicg.f90 krylov/psb_ccg.f90 krylov/psb_ccgs.f90 krylov/psb_ccgstab.f90 krylov/psb_ccgstabl.f90 krylov/psb_ckrylov.f90 krylov/psb_crgmres.f90 krylov/psb_d_inner_krylov_mod.f90 krylov/psb_dbicg.f90 krylov/psb_dcg.F90 krylov/psb_dcgs.f90 krylov/psb_dcgstab.F90 krylov/psb_dcgstabl.f90 krylov/psb_dkrylov.f90 krylov/psb_drgmres.f90 krylov/psb_krylov_mod.f90 krylov/psb_s_inner_krylov_mod.f90 krylov/psb_sbicg.f90 krylov/psb_scg.F90 krylov/psb_scgs.f90 krylov/psb_scgstab.F90 krylov/psb_scgstabl.f90 krylov/psb_skrylov.f90 krylov/psb_srgmres.f90 krylov/psb_z_inner_krylov_mod.f90 krylov/psb_zbicg.f90 krylov/psb_zcg.F90 krylov/psb_zcgs.f90 krylov/psb_zcgstab.f90 krylov/psb_zcgstabl.f90 krylov/psb_zkrylov.f90 krylov/psb_zrgmres.f90 opt/Makefile opt/psb_c_rsb_mat_mod.F90 opt/psb_d_rsb_mat_mod.F90 opt/psb_s_rsb_mat_mod.F90 opt/psb_z_rsb_mat_mod.F90 opt/rsb_c_mod.f90 opt/rsb_d_mod.f90 opt/rsb_s_mod.f90 opt/rsb_z_mod.f90 prec/Makefile prec/psb_c_base_prec_mod.f90 prec/psb_c_bjacprec.f90 prec/psb_c_diagprec.f90 prec/psb_c_nullprec.f90 prec/psb_c_prec_type.f90 prec/psb_cprecbld.f90 prec/psb_d_base_prec_mod.f90 prec/psb_d_bjacprec.f90 prec/psb_d_diagprec.f90 prec/psb_d_nullprec.f90 prec/psb_d_prec_type.f90 prec/psb_dprecbld.f90 prec/psb_s_base_prec_mod.f90 prec/psb_s_bjacprec.f90 prec/psb_s_diagprec.f90 prec/psb_s_nullprec.f90 prec/psb_s_prec_type.f90 prec/psb_sprecbld.f90 prec/psb_z_base_prec_mod.f90 prec/psb_z_bjacprec.f90 prec/psb_z_diagprec.f90 prec/psb_z_nullprec.f90 prec/psb_z_prec_type.f90 prec/psb_zprecbld.f90 test/fileread/cf_sample.f90 test/fileread/df_sample.f90 test/fileread/runs/dfs.inp test/fileread/runs/sfs.inp test/fileread/sf_sample.f90 test/fileread/zf_sample.f90 test/kernel/d_file_spmv.f90 test/kernel/s_file_spmv.f90 test/newfmt/ppde.F90 test/newfmt/spde.f90 test/pargen/ppde.f90 test/pargen/runs/ppde.inp test/pargen/spde.f90 test/serial/Makefile test/serial/d_matgen.F90 test/serial/psb_d_czz_mat_mod.f90 util/Makefile util/psb_c_hbio_impl.f90 util/psb_c_mat_dist_impl.f90 util/psb_c_mmio_impl.f90 util/psb_c_renum_impl.F90 util/psb_d_hbio_impl.f90 util/psb_d_mat_dist_impl.f90 util/psb_d_mmio_impl.f90 util/psb_d_renum_impl.F90 util/psb_hbio_impl.f90 util/psb_mat_dist_mod.f90 util/psb_mmio_impl.f90 util/psb_renum_impl.F90 util/psb_renum_mod.f90 util/psb_s_hbio_impl.f90 util/psb_s_mat_dist_impl.f90 util/psb_s_mmio_impl.f90 util/psb_s_renum_impl.F90 util/psb_z_hbio_impl.f90 util/psb_z_mat_dist_impl.f90 util/psb_z_mmio_impl.f90 util/psb_z_renum_impl.F90 Merged vect-state branch. Now need to: 1. Update MLD 2. Fix documentation 3. Take out older Krylov interfaces.
13 years ago
!!$
!!$ Parallel Sparse BLAS version 2.2
!!$ (C) Copyright 2006/2007/2008
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ 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 PSBLAS 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 PSBLAS 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.
!!$
!!$
! File: psb_sgelp.f90
!
!
! Subroutine: psb_sgelp
! Apply a left permutation to a dense matrix
!
! Arguments:
! trans - character.
! iperm - integer.
! x - real, dimension(:,:).
! info - integer. Return code.
subroutine psb_sgelp(trans,iperm,x,info)
use psb_serial_mod, psb_protect_name => psb_sgelp
use psb_const_mod
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
! local variables
integer :: ictxt
real(psb_spk_),allocatable :: temp(:)
integer :: int_err(5), i1sz, i2sz, err_act,i,j
integer, allocatable :: itemp(:)
real(psb_spk_),parameter :: one=1
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
name = 'psb_sgelp'
if(psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
i1sz = size(x,dim=1)
i2sz = size(x,dim=2)
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': size',i1sz,i2sz
allocate(temp(i1sz),itemp(size(iperm)),stat=info)
if (info /= psb_success_) then
info=2040
call psb_errpush(info,name)
goto 9999
end if
itemp(:) = iperm(:)
if (.not.psb_isaperm(i1sz,itemp)) then
info=psb_err_iarg_invalid_value_
int_err(1) = 1
call psb_errpush(info,name,i_err=int_err)
goto 9999
endif
select case( psb_toupper(trans))
case('N')
do j=1,i2sz
do i=1,i1sz
temp(i) = x(itemp(i),j)
end do
do i=1,i1sz
x(i,j) = temp(i)
end do
end do
case('T')
do j=1,i2sz
do i=1,i1sz
temp(itemp(i)) = x(i,j)
end do
do i=1,i1sz
x(i,j) = temp(i)
end do
end do
case default
info=psb_err_from_subroutine_
ch_err='dgelp'
call psb_errpush(info,name,a_err=ch_err)
end select
deallocate(temp,itemp)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sgelp
!!$
!!$ Parallel Sparse BLAS version 2.2
!!$ (C) Copyright 2006/2007/2008
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ 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 PSBLAS 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 PSBLAS 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: psb_sgelpv
! Apply a left permutation to a dense matrix
!
! Arguments:
! trans - character.
! iperm - integer.
! x - real, dimension(:).
! info - integer. Return code.
subroutine psb_sgelpv(trans,iperm,x,info)
use psb_serial_mod, psb_protect_name => psb_sgelpv
use psb_const_mod
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
! local variables
integer :: ictxt
integer :: int_err(5), i1sz, err_act, i
real(psb_spk_),allocatable :: temp(:)
integer, allocatable :: itemp(:)
real(psb_spk_),parameter :: one=1
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
name = 'psb_sgelpv'
if(psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
i1sz = min(size(x),size(iperm))
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': size',i1sz
allocate(temp(i1sz),itemp(size(iperm)),stat=info)
if (info /= psb_success_) then
info=2040
call psb_errpush(info,name)
goto 9999
end if
itemp(:) = iperm(:)
if (.not.psb_isaperm(i1sz,itemp)) then
info=psb_err_iarg_invalid_value_
int_err(1) = 1
call psb_errpush(info,name,i_err=int_err)
goto 9999
endif
select case( psb_toupper(trans))
case('N')
do i=1,i1sz
temp(i) = x(itemp(i))
end do
do i=1,i1sz
x(i) = temp(i)
end do
case('T')
do i=1,i1sz
temp(itemp(i)) = x(i)
end do
do i=1,i1sz
x(i) = temp(i)
end do
case default
info=psb_err_from_subroutine_
ch_err='dgelp'
call psb_errpush(info,name,a_err=ch_err)
end select
deallocate(temp,itemp)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sgelpv