drotm Subroutine

public subroutine drotm(n, dx, incx, dy, incy, dparam)

apply the modified givens transformation, H, to the 2 by n matrix

Arguments

Type IntentOptional 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)

Called by

proc~~drotm~~CalledByGraph proc~drotm bspline_blas_module::drotm proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~drotm proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~drotm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn

Source Code

   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