i22sto.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/.
!||====================================================================
!||    i22sto       ../engine/source/interfaces/intsort/i22sto.F
!||--- called by ------------------------------------------------------
!||    i22trivox    ../engine/source/interfaces/intsort/i22trivox.F
!||--- uses       -----------------------------------------------------
!||    i22tri_mod   ../common_source/modules/interfaces/cut-cell-search_mod.F
!||====================================================================
      SUBROUTINE i22sto(
     1      J_STOK ,IRECT   ,X       ,II_STOK ,CAND_B,
     2      CAND_E ,MULNSN  ,NOINT   ,MARGE   ,I_MEM ,
     3      PROV_B ,PROV_E  ,ESHIFT  ,ITASK   ,NC    ,
     4      IXS    ,BUFBRIC ,NBRIC   ,IsSTO )
C============================================================================
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE i22tri_mod !pour le debug uniquement
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,NIN, ITASK, IXS(NIXS,*), nbric
      INTEGER J_STOK,MULNSN,NOINT,INACTI,ESHIFT,BUFBRIC(NBRIC)
      INTEGER IRECT(4,*),CAND_B(*),CAND_E(*),  NC
      INTEGER PROV_B(MVSIZ),PROV_E(MVSIZ),  II_STOK
      LOGICAL IsSTO
      my_real
     .        x(3,*),  marge
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
C-----------------------------------------------
 
      IF(.NOT.IsSTO)THEN         
        issto=.true.
c        if(ibug22_trivox==1)print *, "   lockon", ITASK
#include "lockon.inc" 
      END IF
 
      i_stok = ii_stok
 
      IF(i_stok + j_stok>mulnsn) THEN
        i_mem = 2 ! Pas assez de place allouee  
        issto = .false.
        !II_STOK = ZERO fait dans i22buce     
c        if(ibug22_trivox==1)print *, "   lockoff", ITASK             
#include "lockoff.inc"  
        RETURN
      ENDIF
 
      DO i=1,j_stok         
        i_stok = i_stok + 1                         
        cand_b(i_stok) = prov_b(i) !numero de la brique dans le groupe local
        cand_e(i_stok) = prov_e(i) !est deja un numero global (1:NIRECT_L) pas besoin ESHIFT    
c        if(ibug22_trivox==1)WRITE(*,FMT='(A,I8,A,I8,I8)')
c     .   "   I22sto : ecriture Bric=", 
c     .   IXS(11,BUFBRIC(PROV_B(I))), " ShellDiag= ",
c     .   NINT(IRECT_L((/1,3/),ABS(PROV_E(I))))
c        if(ibug22_trivox==1)print *, ""
      ENDDO
C-----------------------------------------------
      ii_stok = ii_stok + j_stok
         
!#include "lockoff.inc"  lockoff seulement losque la brique courante est completement traitee
 
      RETURN
      END