ig3donebasis.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/.
!||====================================================================
!||    ig3donebasis   ../starter/source/elements/ige3d/ig3donebasis.F
!||--- called by ------------------------------------------------------
!||    ssurfigeo      ../starter/source/groups/ssurftagigeo.F
!||--- calls      -----------------------------------------------------
!||    onebasisfun    ../starter/source/elements/ige3d/onebasisfun.F
!||--- uses       -----------------------------------------------------
!||    message_mod    ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE ig3donebasis(
     1 ITEL  ,N     ,XXI   ,YYI   ,
     2 ZZI   ,WWI   ,IDX   ,IDY   ,
     3 IDZ   ,KNOTLOCX ,KNOTLOCY ,KNOTLOCZ ,
     4 R     ,NCTRL ,
     5 GAUSSX,GAUSSY,GAUSSZ,KX    ,
     6 KY    ,KZ    ,PX    ,
     7 PY    ,PZ    ,BOOLG ,
     8 IDX2  ,IDY2  ,IDZ2  ,
     9 KNOTLOCELX,KNOTLOCELY,KNOTLOCELZ)
C--------------------------------------------------------------------------------------------------------
C
C This subroutine calculates the vector of local shape functions R and an array of their derivatives dR.dx
C The Jacobian determinant J may be returned to if it's necessary
C This subroutine is called by ig3dinit3 for every LR or Truncated element
C
C--------------------------------------------------------------------------------------------------------
C VAR         | SIZE      |  TYP  |  RW   |  DEFINITION
C--------------------------------------------------------------------------------------------------------
C ITEL        |  1           | I  |  R  |  ELEMENT ID 
C N           |  1           |  I  |   R   | GAUSS POINT ID
C XXI         | NCTRL       | F  |  R  | X COORDINATE of ELEMENT I CONTROL POINTS in global frame
C YYI         | NCTRL       | F  |  R  | Y COORDINATE of ELEMENT I CONTROL POINTS in global frame
C ZZI         | NCTRL       | F  |  R  | Z COORDINATE of ELEMENT I CONTROL POINTS in global frame
C WWI         |  NCTRL       |  F  |   R  |  WEIGHT OF ELEMENT I CONTROL POINTS 
C IDX         |  1           |  I  |   R  |  ELEMENT FIRST INDEX IN KNOT VECTOR IN X DIRECTION
C IDY         |  1           |  I  |   R  |  ELEMENT FIRST INDEX IN KNOT VECTOR IN Y DIRECTION
C IDZ         |  1           |  I  |   R  |  ELEMENT FIRST INDEX IN KNOT VECTOR IN Z DIRECTION
C IDX2        |  1           |  I  |   R  |  ELEMENT LAST INDEX IN KNOT VECTOR IN X DIRECTION
C IDY2        |  1           |  I  |   R  |  ELEMENT LAST INDEX IN KNOT VECTOR IN Y DIRECTION
C IDZ2        |  1           |  I  |   R  |  ELEMENT LAST INDEX IN KNOT VECTOR IN Z DIRECTION
C R           |  NCTRL       |  F  |   W  |  ARRAY OF TRIVIATE NURBS BASIS FUNCTION
C GAUSSX      |  1           |  F  |   R  |  COORDINATES IN DIRECTION X OF GAUSS POINT 
C GAUSSY      |  1           |  F  |   R  |  COORDINATES IN DIRECTION Y OF GAUSS POINT 
C GAUSSZ      |  1           |  F  |   R  |  COORDINATES IN DIRECTION Z OF GAUSS POINT 
C NCTRL       |  1           |  I  |   R  |  NUMBER OF ELEMENT CONTROL POINTS IN CURRENT GROUP
C PX          |  1           | I  |   R  |  POLYNOMIAL INTERPOLATION DEGREE IN X DIRECTION
C PY          |  1           | I  |   R  |  POLYNOMIAL INTERPOLATION DEGREE IN Y DIRECTION
C PZ          |  1           | I  |   R  |  POLYNOMIAL INTERPOLATION DEGREE IN Z DIRECTION
C KX          |  NKX         |  F  |   R  |  (FULL) KNOT VECTOR IN X DIRECTION FOR THE CURRENT PATCH
C KY          |  NKY         |  F  |   R  |  (FULL) KNOT VECTOR IN Y DIRECTION FOR THE CURRENT PATCH
C KZ          |  NKZ         |  F  |   R  |  (FULL) KNOT VECTOR IN Z DIRECTION FOR THE CURRENT PATCH
C KNOTLOCX    | PX+2,NCTRL  |  F  |   R  |  LOCAL KNOT VECTOR IN X DIRECTION FOR EACH CONTROL POINT
C KNOTLOCY    |  PY+2,NCTRL  |  F  |   R  |  LOCAL KNOT VECTOR IN Y DIRECTION FOR EACH CONTROL POINT
C KNOTLOCZ    |  PZ+2,NCTRL  |  F  |   R  |  LOCAL KNOT VECTOR IN Z DIRECTION FOR EACH CONTROL POINT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include     "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IDX, IDY, IDZ, NCTRL, PX, PY, PZ,
     .        itel, n, boolg,idx2, idy2, idz2
      my_real
     .  gaussx, gaussy, gaussz,
     .  r(*),xxi(*),yyi(*),zzi(*),
     .  wwi(*),kx(*), ky(*), kz(*), knotlocx(px+2,nctrl),
     .  knotlocy(py+2,nctrl),knotlocz(pz+2,nctrl),knotlocelx(2),
     .  knotlocely(2),knotlocelz(2)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NUMLOC, I, J, K, NA, NB, NC
      my_real
     .  SUMTOT, FN(NCTRL), FM(NCTRL),
     .  FL(NCTRL),XI(3)
C=======================================================================
C   S o u r c e  L i n e s
C=======================================================================
C
      IF (BOOLG == 1) then
C CALCULATE PARAMETRIC COORDINATES OF THE GAUSS POINT FROM PARENT ELEMENT COORDINATES, FOR THE THREE DIRECTIONS
       xi(1) = ((knotlocelx(2)-knotlocelx(1))*gaussx + (knotlocelx(2)+(knotlocelx(1))))/two
       xi(2) = ((knotlocely(2)-knotlocely(1))*gaussy + (knotlocely(2)+(knotlocely(1))))/two
       xi(3) = ((knotlocelz(2)-knotlocelz(1))*gaussz + (knotlocelz(2)+(knotlocelz(1))))/two
c       XI(1) = ((KX(IDX2)-KX(IDX))*GAUSSX + (KX(IDX2)+(KX(IDX))))/TWO
c       XI(2) = ((KY(IDY2)-KY(IDY))*GAUSSY + (KY(IDY2)+(KY(IDY))))/TWO
c       XI(3) = ((KZ(IDZ2)-KZ(IDZ))*GAUSSZ + (KZ(IDZ2)+(KZ(IDZ))))/TWO
      ELSE
       xi(1) = gaussx
       xi(2) = gaussy
       xi(3) = gaussz
      ENDIF
 
C CALCULATE B-SPLINE FUNCTION AT XI POINT
 
c      DO NUMLOC=1,NCTRL
c        CALL ONEBASISFUN(1, PX, XI(1), KNOTLOCX(:,NUMLOC), FN(NUMLOC))
c        CALL ONEBASISFUN(1, PY, XI(2), KNOTLOCY(:,NUMLOC), FM(NUMLOC))
c        CALL ONEBASISFUN(1, PZ, XI(3), KNOTLOCZ(:,NUMLOC), FL(NUMLOC))
c      ENDDO
 
      numloc = 0
      DO k=1,pz+1
        DO j=1,py+1
          DO i=1,px+1
            numloc = numloc+1
            CALL onebasisfun(i, 1, px, xi(1), knotlocx(:,numloc), fn(numloc))
            CALL onebasisfun(j, 1, py, xi(2), knotlocy(:,numloc), fm(numloc))
            CALL onebasisfun(k, 1, pz, xi(3), knotlocz(:,numloc), fl(numloc))
          ENDDO
        ENDDO
      ENDDO
 
C BUILD NUMERATORS AND DENOMINATORS
 
      sumtot=zero
 
      DO numloc=1,nctrl
        r(numloc)=fn(numloc)*fm(numloc)*fl(numloc)*wwi(numloc) 
        sumtot=sumtot+r(numloc)
      ENDDO
 
C DIVIDE BY DENOMINATOR TO COMPLETE DEFINITION OF FUNCTION
 
      DO numloc=1,nctrl
        r(numloc)=r(numloc)/sumtot
      ENDDO
 
      RETURN 
      END