dersonebasisfun.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
c      SUBROUTINE DERSONEBASISFUN(IDXII, IDXI, PXI, XI, KXI, DERS1, DERS2)
!||====================================================================
!||    dersonebasisfun   ../engine/source/elements/ige3d/dersonebasisfun.f
!||--- called by ------------------------------------------------------
!||    ig3donederiv      ../engine/source/elements/ige3d/ig3donederiv.F
!||====================================================================
      SUBROUTINE dersonebasisfun(IDXI, PXI, XI, KXI, DERS1, DERS2)
C--------------------------------------------------------------------------------------------------------
C
C This subroutine calculates B-spline function and derivate of B-spline function
C Assembling B spline functions for NURBS is outside this subroutine 
C
C--------------------------------------------------------------------------------------------------------
C VAR      | SIZE      | TYP  |  RW  |  DEFINITION
C--------------------------------------------------------------------------------------------------------
C IDXI     | 1         | I    |  R   | ELEMENT INDEX IN KNOT VECTOR IN XI DIRECTION
C PXI      | 1         | I    |  R   | POLYNOMIAL INTERPOLATION DEGREE IN XI DIRECTION
C XI       | 1         | F    |  R   | COUNTER PARAMETER VALUE (WHERE THE FUNCTION AND DERIVATE ARE CALCULATED)
C--------------------------------------------------------------------------------------------------------
C KXI      | NKXI      | F    |  R   | (FULL) KNOT VECTOR IN XI DIRECTION FOR THE CURRENT PATCH (GROUP)
C--------------------------------------------------------------------------------------------------------
C DERS1    | PXI+1     | F    |  W   | INTERPOLATION FUNCTION
C DERS2    | PXI+1     | F    |  W   | DERIVATE OF INTERPOLATION FUNCTION
C--------------------------------------------------------------------------------------------------------
C Implicite Types
C--------------------------------------------------------------------------------------------------------
#include     "implicit_f.inc"
C--------------------------------------------------------------------------------------------------------
C Dummy Arguments 
C--------------------------------------------------------------------------------------------------------
      INTEGER PXI, IDXI!, IDXII
      my_real, 
     .  INTENT(IN) :: xi
      my_real, 
     .  DIMENSION(*), INTENT(IN) :: kxi
      my_real ders1, ders2
C--------------------------------------------------------------------------------------------------------
C Local variables 
C--------------------------------------------------------------------------------------------------------
      INTEGER J, JJ, K, NDERS
      my_real saved, temp, aleft, right
      my_real, DIMENSION(2) :: ders
      my_real, DIMENSION(PXI+1,PXI+1) :: andu
      my_real, DIMENSION(PXI+1) :: nd
 
      nders=1
      andu(:,:)=zero
!      ANDU(IDXII,1)=ONE
 
      DO j=0,pxi
        IF ((xi>=kxi(idxi+j)).AND.(xi<kxi(idxi+j+1))) THEN
          andu(j+1,1) = one
        ELSE
          andu(j+1,1) = zero
        ENDIF
      ENDDO
 
      DO k=1,pxi
        IF (andu(1,k) == 0) THEN
          saved = zero
        ELSE 
          saved = ((xi-kxi(idxi))*andu(1,k))/(kxi(idxi+k)-kxi(idxi))
        ENDIF
        DO j=0,pxi-k
          aleft = kxi(idxi+j+1)
          right = kxi(idxi+j+k+1)
          IF (andu(j+2,k) == 0) THEN
            andu(j+1,k+1) = saved
            saved = zero
          ELSE
            temp = andu(j+2,k)/(right-aleft)
            andu(j+1,k+1) = saved+(right-xi)*temp
            saved = (xi-aleft)*temp
          ENDIF  
        ENDDO
      ENDDO
      
      ders(1) = andu(1,pxi+1) 
 
      DO k=1,nders
        DO j=1,k+1
          nd(j) = andu(j,pxi-k+1)
        ENDDO
        DO jj=1,k
          IF (nd(1) == 0) THEN
            saved = zero
          ELSE 
            saved = nd(1)/(kxi(idxi+pxi-k+jj)-kxi(idxi))
          ENDIF
          DO j=1,k-jj+1
            aleft = kxi(idxi+j)
            right = kxi(idxi+j+pxi+jj-1)
c            RIGHT = KXI(IDXI+J+PXI+JJ+1)
            IF (nd(j+1) == 0) THEN
              nd(j) = (pxi-k+jj)*saved
              saved = zero
            ELSE
              temp = nd(j+1)/(right-aleft)
              nd(j) = (pxi-k+jj)*(saved-temp)
              saved = temp
            ENDIF
          ENDDO
        ENDDO
      ders(2) = nd(1)
      ENDDO
 
      ders1 = ders(1)
      ders2 = ders(2)
 
      RETURN
      END