i10sto.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/.
!||====================================================================
!||    i10sto    ../engine/source/interfaces/intsort/i10sto.F
!||--- called by ------------------------------------------------------
!||    i10tri    ../engine/source/interfaces/intsort/i10tri.F
!||--- calls      -----------------------------------------------------
!||    i7cor3t   ../engine/source/interfaces/int07/i7cor3t.F
!||    i7pen3    ../engine/source/interfaces/intsort/i7pen3.F
!||====================================================================
      SUBROUTINE i10sto(
     1      J_STOK,IRECT ,X      ,NSV   ,II_STOK,
     2      CAND_N,CAND_E,NSN4   ,NOINT ,MARGE  ,
     3      I_MEM ,PROV_N,PROV_E ,CAND_A,ESHIFT ,
     4      NSN   ,OLDNUM,NSNROLD,IGAP  ,GAP    ,
     6      GAP_S ,GAP_M ,GAPMIN ,GAPMAX,NIN    )
C============================================================================
C  cette routine est appelee par : I10TRI(/int10/i10tri.F)
C----------------------------------------------------------------------------
C  cette routine appelle : I7COR3T(/int7/i7cor3.F)
C                          I7PEN3(/int7/i7pen3.F)
C                          MY_LOCK(/spe/machine.F)
C                          MY_FREE
C============================================================================
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,J_STOK,NSN4,NOINT,ESHIFT,NSN,NSNROLD,IGAP,NIN
      INTEGER IRECT(4,*),NSV(*),CAND_N(*),CAND_E(*),CAND_A(*)
      INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ), OLDNUM(*),II_STOK
C     REAL
      my_real
     .   x(3,*), gap_s(*), gap_m(*),
     .   marge, gap, gapmin, gapmax, bid
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K_STOK,I_STOK,N,NE,NN,IBID
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
     .        NSVG(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), stif(mvsiz), 
     .   pene(mvsiz), gapv(mvsiz), rbid
C-----------------------------------------------
       ibid = 0
       rbid = zero
        CALL i7cor3t(j_stok  ,x     ,irect ,nsv   ,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    ,stif  ,ix1    ,
     5               ix2     ,ix3   ,ix4   ,nsn   ,gap_s  ,
     6               gap_m   ,gapv  ,gapmax,gapmin,bid    ,
     7               10      ,nin   ,rbid  ,rbid  ,ibid   ,
     8               rbid    ,rbid  )
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) THEN
            n  = prov_n(i)
            IF(n>nsn) THEN
C numerotation tris precedent pour les noeuds non locaux (SPMD)
              n = oldnum(n-nsn)+nsn
              IF(n==nsn) n = nsn+nsnrold+1
            END IF
C   attention au shift
            ne = prov_e(i)+eshift
            DO j = cand_a(n),cand_a(n+1)-1
              IF (cand_e(j)==ne) GOTO 100
            ENDDO
            k_stok = k_stok + 1
 100        CONTINUE
          ENDIF                        
        ENDDO
C
        IF(k_stok==0)RETURN
C
#include "lockon.inc"
          i_stok = ii_stok
          IF(i_stok+k_stok>nsn4) 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
            n  = prov_n(i)
            nn = n
            IF(n>nsn) THEN
C numerotation tris precedent pour les noeuds non locaux (SPMD)
              n = oldnum(n-nsn)+nsn
              IF(n==nsn) n = nsn+nsnrold+1
            END IF
C   attention au shift
            ne = prov_e(i)+eshift
            DO j = cand_a(n),cand_a(n+1)-1
              IF (cand_e(j)==ne) GOTO 200
            ENDDO 
            i_stok = i_stok + 1
            cand_n(i_stok) = nn
            cand_e(i_stok) = ne
 200        CONTINUE
          ENDIF
        ENDDO
C-----------------------------------------------
      RETURN
      END