dwght Subroutine

public pure subroutine dwght(n, m, wt, ldwt, ld2wt, t, wtt)

Uses

  • proc~~dwght~~UsesGraph proc~dwght dwght module~odrpack_kinds odrpack_kinds proc~dwght->module~odrpack_kinds iso_fortran_env iso_fortran_env module~odrpack_kinds->iso_fortran_env

Scale matrix t using wt, i.e., compute wtt = wt*t.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: n

The number of rows of data in t.

integer, intent(in) :: m

The number of columns of data in t.

real(kind=wp), intent(in) :: wt(:,:,:)

The weights.

integer, intent(in) :: ldwt

The leading dimension of array wt.

integer, intent(in) :: ld2wt

The second dimension of array wt.

real(kind=wp), intent(in) :: t(:,:)

The array being scaled by wt.

real(kind=wp), intent(out) :: wtt(:,:)

The results of weighting array t by wt. Array wtt can be the same as t only if the arrays in wt are upper triangular with zeros below the diagonal.


Called by

proc~~dwght~~CalledByGraph proc~dwght dwght proc~devjac devjac proc~devjac->proc~dwght proc~doddrv doddrv proc~doddrv->proc~dwght proc~dodmn dodmn proc~doddrv->proc~dodmn proc~dodlm dodlm proc~dodlm->proc~dwght proc~dodstp dodstp proc~dodlm->proc~dodstp proc~dodmn->proc~dwght proc~dodmn->proc~devjac proc~dodmn->proc~dodlm proc~dodvcv dodvcv proc~dodmn->proc~dodvcv proc~dodstp->proc~dwght proc~dodcnt dodcnt proc~dodcnt->proc~doddrv proc~dodvcv->proc~dodstp proc~odr odr proc~odr->proc~dodcnt proc~odr_long_c odr_long_c proc~odr_long_c->proc~odr proc~odr_medium_c odr_medium_c proc~odr_medium_c->proc~odr proc~odr_short_c odr_short_c proc~odr_short_c->proc~odr program~example1 example1 program~example1->proc~odr program~example2 example2 program~example2->proc~odr program~example3 example3 program~example3->proc~odr program~example4 example4 program~example4->proc~odr program~example5 example5 program~example5->proc~odr

Variables

Type Visibility Attributes Name Initial
real(kind=wp), public :: temp
integer, public :: i
integer, public :: j
integer, public :: k

Source Code

   pure subroutine dwght(n, m, wt, ldwt, ld2wt, t, wtt)
   !! Scale matrix `t` using `wt`, i.e., compute `wtt = wt*t`.
      ! Routines Called  (NONE)
      ! Date Written   860529   (YYMMDD)
      ! Revision Date  920304   (YYMMDD)

      use odrpack_kinds, only: zero

      integer, intent(in) :: n
         !! The number of rows of data in `t`.
      integer, intent(in) :: m
         !! The number of columns of data in `t`.
      integer, intent(in) :: ldwt
         !! The leading dimension of array `wt`.
      integer, intent(in) :: ld2wt
         !! The second dimension of array `wt`.
      real(wp), intent(in) :: wt(:, :, :)
         !! The weights.
      real(wp), intent(in) :: t(:, :)
         !! The array being scaled by `wt`.
      real(wp), intent(out) :: wtt(:, :)
         !! The results of weighting array `t` by `wt`. Array `wtt` can be the same as `t` only if
         !! the arrays in `wt` are upper triangular with zeros below the diagonal.

      ! Local scalars
      real(wp) :: temp
      integer :: i, j, k

      ! Variable Definitions (alphabetically)
      !  I:       An indexing variable.
      !  J:       An indexing variable.
      !  K:       An indexing variable.
      !  LDWT:    The leading dimension of array WT.
      !  LD2WT:   The second dimension of array WT.
      !  M:       The number of columns of data in T.
      !  N:       The number of rows of data in T.
      !  T:       The array being scaled by WT.
      !  TEMP:    A temporary scalar.
      !  WT:      The weights.
      !  WTT:     The results of weighting array T by WT. Array WTT can be the same as T only if
      !           the arrays in WT are upper triangular with zeros below the diagonal.

      if (n == 0 .or. m == 0) return

      if (wt(1, 1, 1) >= zero) then
         if (ldwt >= n) then
            if (ld2wt >= m) then
               ! WT is an N-array of M by M matrices
               do i = 1, n
                  do j = 1, m
                     temp = zero
                     do k = 1, m
                        temp = temp + wt(i, j, k)*t(i, k)
                     end do
                     wtt(i, j) = temp
                  end do
               end do
            else
               ! WT is an N-array of diagonal matrices
               do i = 1, n
                  do j = 1, m
                     wtt(i, j) = wt(i, 1, j)*t(i, j)
                  end do
               end do
            end if
         else
            if (ld2wt >= m) then
               ! WT is an M by M matrix
               do i = 1, n
                  do j = 1, m
                     temp = zero
                     do k = 1, m
                        temp = temp + wt(1, j, k)*t(i, k)
                     end do
                     wtt(i, j) = temp
                  end do
               end do
            else
               ! WT is a diagonal matrice
               do i = 1, n
                  do j = 1, m
                     wtt(i, j) = wt(1, 1, j)*t(i, j)
                  end do
               end do
            end if
         end if
      else
         ! WT is a scalar
         do j = 1, m
            do i = 1, n
               wtt(i, j) = abs(wt(1, 1, 1))*t(i, j)
            end do
         end do
      end if

   end subroutine dwght