!> !> @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 . !> !> @author !> (in alphabetical order) !> @author Trach-Minh Tran !> 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