Homec4science
Diffusion SPClibs (feature/refactoring) Browse

spclibs/pppack/shiftb.f90
8f478ec0accefeature/refactoring

Last Change
Raw File

shiftb.f90
View Options

!>
!> @file shiftb.f90
!>
!> @brief
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> SPClibs is free software: you can redistribute it and/or modify it under
!> the terms of the GNU Lesser General Public License as published by the Free
!> Software Foundation, either version 3 of the License, or (at your option)
!> any later version.
!>
!> SPClibs is distributed in the hope that it will be useful, but WITHOUT ANY
!> WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
!> FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
!>
!> You should have received a copy of the GNU Lesser General Public License
!> along with this program. If not, see <https://www.gnu.org/licenses/>.
!>
!> @author
!> (in alphabetical order)
!> @author Trach-Minh Tran <trach-minh.tran@epfl.ch>
!>
subroutine shiftb ( ai, ipivot, nrowi, ncoli, last, ai1, nrowi1, ncoli1 )
!*************************************************************************
!
!! SHIFTB shifts the rows in current block, ai, not used as pivot
! rows, if any, i.e., rows ipivot(last+1),...,ipivot(nrowi),
! onto the first mmax=nrow-last rows of the next block, ai1,
! with column last+j of ai going to column j ,
! for j=1,...,jmax=ncoli-last. the remaining columns of these
! rows of ai1 are zeroed out.
!
! picture
!
! original situation after results in a new block i+1
! last=2 columns have been created and ready to be
! done in factrb (assuming no factored by next factrb call.
! interchanges of rows)
! 1
! x x 1x x x x x x x x
! 1
! 0 x 1x x x 0 x x x x
! block i 1 ---
! nrowi=4 0 0 1x x x 0 0 1x x x 0 01
! ncoli=5 1 1 1
! last=2 0 0 1x x x 0 0 1x x x 0 01
! ------------------- 1 1 new
! 1x x x x x 1x x x x x1 block
! 1 1 1 i+1
! block i+1 1x x x x x 1x x x x x1
! nrowi1= 5 1 1 1
! ncoli1= 5 1x x x x x 1x x x x x1
! ------------------- 1-------------1
! 1
!
! Reference:
!
! Carl DeBoor,
! A Practical Guide to Splines,
! Springer Verlag.
!
implicit none
integer ncoli
integer ncoli1
integer nrowi1
integer nrowi
real ( kind = 8 ) ai(nrowi,ncoli)
real ( kind = 8 ) ai1(nrowi1,ncoli1)
integer ip
integer ipivot(nrowi)
integer j
integer last
integer m
if ( nrowi-last < 1 ) then
return
end if
if ( ncoli-last < 1 ) then
return
end if
!
! Put the remainder of block I into AI1.
!
do m = 1, nrowi-last
ip = ipivot(last+m)
do j = 1, ncoli-last
ai1(m,j) = ai(ip,last+j)
end do
end do
!
! Zero out the upper right corner of ai1.
!
do j = ncoli+1-last, ncoli1
do m = 1, nrowi-last
ai1(m,j) = 0.0D+00
end do
end do
return
end
c4science · Help