i21sto.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/.
!||====================================================================
!||    i21sto     ../engine/source/interfaces/int21/i21sto.F
!||--- called by ------------------------------------------------------
!||    i21tri     ../engine/source/interfaces/intsort/i21tri.F
!||--- calls      -----------------------------------------------------
!||    i21cor3t   ../engine/source/interfaces/int21/i21cor3t.F
!||    i7pen3     ../engine/source/interfaces/intsort/i7pen3.F
!||====================================================================
      SUBROUTINE i21sto(
     1      J_STOK   ,IRECT  ,XLOC   ,II_STOK,CAND_N   ,
     2      CAND_E ,MULNSN ,NOINT      ,MARGE  ,I_MEM  ,
     3      PROV_N ,PROV_E ,ESHIFT     ,INACTI ,NSN    ,
     4      IGAP     ,GAP  ,GAP_S      ,GAPMIN ,GAPMAX ,
     5      CURV_MAX ,XM0  ,NOD_NORMAL ,DEPTH  ,DRAD   ,
     6      DGAPLOAD )
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER I_MEM, NSN,IGAP
      INTEGER J_STOK,MULNSN,NOINT,INACTI,ESHIFT,II_STOK
      INTEGER IRECT(4,*),CAND_N(*),CAND_E(*)
      INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ)
C     REAL
      my_real
     .        xloc(3,*), gap_s(*), 
     .        marge, gap, gapmin, gapmax, curv_max(*),
     .        depth, xm0(3,*), nod_normal(3,*)
      my_real , INTENT(IN) :: dgapload,drad
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K_STOK,I_STOK,N,NE,J
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
C     REAL
      my_real
     .   x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
     .   y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
     .   z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .   xi(mvsiz), yi(mvsiz), zi(mvsiz),
     .   nnx1(mvsiz), nnx2(mvsiz), nnx3(mvsiz), nnx4(mvsiz),
     .   nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
     .   nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz),
     .   pene(mvsiz), gapv(mvsiz)
C-----------------------------------------------
        CALL i21cor3t(j_stok ,xloc ,irect ,prov_e ,
     1               prov_n  ,igap ,gap   ,x1    ,x2     ,
     2               x3      ,x4   ,y1    ,y2   ,y3   ,
     3               y4      ,z1   ,z2    ,z3   ,z4   ,
     4               xi      ,yi   ,zi    ,ix1   ,ix2    ,  
     5               ix3     ,ix4  ,nsn   ,gap_s ,gapv   ,
     6               gapmax  ,gapmin,curv_max,depth ,xm0 ,
     7               drad    ,dgapload)
C-----------------------------------------------
        CALL i7pen3(j_stok ,marge  ,x1    ,x2     ,x3   ,
     .               x4    ,y1     ,y2    ,y3     ,y4   ,
     .               z1    ,z2     ,z3    ,z4     ,xi   ,
     .               yi    ,zi     ,pene  ,ix1    ,ix2  ,
     .               ix3   ,ix4    ,igap  ,gap    ,gapv )
C-----------------------------------------------
        k_stok = 0
        DO i=1,j_stok
          IF(pene(i)/=zero) k_stok = k_stok + 1
        ENDDO
        IF(k_stok==0)RETURN
C
#include "lockon.inc"
          i_stok = ii_stok 
          IF(i_stok+k_stok>mulnsn) THEN
            i_mem = 2
#include "lockoff.inc"
            RETURN
          ENDIF
          ii_stok   = i_stok + k_stok
#include "lockoff.inc"
C-----------------------------------------------
        DO i=1,j_stok
          IF(pene(i)/=zero)THEN
            i_stok = i_stok + 1
            cand_n(i_stok) = prov_n(i)
            cand_e(i_stok) = prov_e(i)+eshift
          ENDIF
        ENDDO
C-----------------------------------------------
      RETURN
      END