apply the modified givens transformation, H, to the 2 by n matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=ip) | :: | n | ||||
real(kind=wp) | :: | dx(*) | ||||
integer(kind=ip) | :: | incx | ||||
real(kind=wp) | :: | dy(*) | ||||
integer(kind=ip) | :: | incy | ||||
real(kind=wp) | :: | dparam(5) |
subroutine drotm(n,dx,incx,dy,incy,dparam) !! apply the modified givens transformation, H, to the 2 by n matrix integer(ip) :: incx,incy,n real(wp) :: dparam(5),dx(*),dy(*) real(wp) :: dflag,dh11,dh12,dh21,dh22,w,z integer(ip) :: i,kx,ky,nsteps real(wp),parameter :: zero = 0.0_wp real(wp),parameter :: two = 2.0_wp dflag = dparam(1) if (n<=0 .or. (dflag+two==zero)) return if (incx==incy.and.incx>0) then nsteps = n*incx if (dflag<zero) then dh11 = dparam(2) dh12 = dparam(4) dh21 = dparam(3) dh22 = dparam(5) do i = 1,nsteps,incx w = dx(i) z = dy(i) dx(i) = w*dh11 + z*dh12 dy(i) = w*dh21 + z*dh22 end do else if (dflag==zero) then dh12 = dparam(4) dh21 = dparam(3) do i = 1,nsteps,incx w = dx(i) z = dy(i) dx(i) = w + z*dh12 dy(i) = w*dh21 + z end do else dh11 = dparam(2) dh22 = dparam(5) do i = 1,nsteps,incx w = dx(i) z = dy(i) dx(i) = w*dh11 + z dy(i) = -w + dh22*z end do end if else kx = 1 ky = 1 if (incx<0) kx = 1 + (1-n)*incx if (incy<0) ky = 1 + (1-n)*incy if (dflag<zero) then dh11 = dparam(2) dh12 = dparam(4) dh21 = dparam(3) dh22 = dparam(5) do i = 1,n w = dx(kx) z = dy(ky) dx(kx) = w*dh11 + z*dh12 dy(ky) = w*dh21 + z*dh22 kx = kx + incx ky = ky + incy end do else if (dflag==zero) then dh12 = dparam(4) dh21 = dparam(3) do i = 1,n w = dx(kx) z = dy(ky) dx(kx) = w + z*dh12 dy(ky) = w*dh21 + z kx = kx + incx ky = ky + incy end do else dh11 = dparam(2) dh22 = dparam(5) do i = 1,n w = dx(kx) z = dy(ky) dx(kx) = w*dh11 + z dy(ky) = -w + dh22*z kx = kx + incx ky = ky + incy end do end if end if end subroutine drotm