onebasisfun.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/.
!||====================================================================
!||    onebasisfun    ../starter/source/elements/ige3d/onebasisfun.F
!||--- called by ------------------------------------------------------
!||    ig3donebasis   ../starter/source/elements/ige3d/ig3donebasis.F
!||====================================================================
      SUBROUTINE onebasisfun(IDXII, IDXI, PXI, XI, KXI, DERS1)
C--------------------------------------------------------------------------------------------------------
C
C This subroutine calculates 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 DERIVATIVE 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   | DERIVATIVE 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
C--------------------------------------------------------------------------------------------------------
C Local variables 
C--------------------------------------------------------------------------------------------------------
      INTEGER :: J, K
      my_real :: saved, temp, aleft, right
      my_real, DIMENSION(PXI+1,PXI+1) :: andu
 
      andu(:,:)=zero
      andu(idxii,1)=one
 
c      DO J=0,PXI
c        IF ((XI>=KXI(IDXI+J)).AND.(XI<KXI(IDXI+J+1))) THEN
c          ANDU(J+1,1) = ONE
c        ELSE
c          ANDU(J+1,1) = ZERO
c        ENDIF
c      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
      
      ders1 = andu(1,pxi+1) 
 
      RETURN
      END