CalculateInterpolationMatrix Subroutine

public subroutine CalculateInterpolationMatrix(this)

Arguments

TypeIntentOptionalAttributesName
class(Lagrange_t), intent(inout) :: this

Calls

proc~~calculateinterpolationmatrix~~CallsGraph proc~calculateinterpolationmatrix CalculateInterpolationMatrix interface~almostequal AlmostEqual proc~calculateinterpolationmatrix->interface~almostequal proc~almostequal_r64 AlmostEqual_r64 interface~almostequal->proc~almostequal_r64

Contents


Source Code

  subroutine CalculateInterpolationMatrix(this)
    implicit none
    class(Lagrange_t),intent(inout) :: this
    ! Local
    integer    :: row,col
    logical    :: rowHasMatch
    real(real64) :: temp1,temp2
    real(real64) :: iMatrix(0:this%M,0:this%N)
    real(real64) :: bWeights(0:this%N)
    real(real64) :: controlPoints(0:this%N)
    real(real64) :: targetPoints(0:this%M)

    do col = 0,this%N
      controlPoints(col) = real(this%controlPoints(col+1),real64)
      bWeights(col) = real(this%bWeights(col+1),real64)
    enddo
    do row = 0,this%M
      targetPoints(row) = real(this%targetPoints(row+1),real64)
    enddo

    do row = 0,this%M

      rowHasMatch = .false.

      do col = 0,this%N

        iMatrix(row,col) = 0.0_real64

        if(AlmostEqual(targetPoints(row),controlPoints(col))) then
          rowHasMatch = .true.
          iMatrix(row,col) = 1.0_real64
        endif

      enddo

      if(.not.(rowHasMatch)) then

        temp1 = 0.0_real64

        do col = 0,this%N
          temp2 = bWeights(col)/ &
                  (targetPoints(row)- &
                   controlPoints(col))
          iMatrix(row,col) = temp2
          temp1 = temp1+temp2
        enddo

        do col = 0,this%N
          iMatrix(row,col) = iMatrix(row,col)/temp1
        enddo

      endif

    enddo

    do row = 0,this%M
      do col = 0,this%N
        this%iMatrix(col+1,row+1) = real(iMatrix(row,col),prec)
      enddo
    enddo

  endsubroutine CalculateInterpolationMatrix