i10buce.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/.
!||====================================================================
!||    i10buce       ../engine/source/interfaces/intsort/i10buce.F
!||--- called by ------------------------------------------------------
!||    i10main_tri   ../engine/source/interfaces/intsort/i10main_tri.F
!||--- calls      -----------------------------------------------------
!||    ancmsg        ../engine/source/output/message/message.f
!||    arret         ../engine/source/system/arret.F
!||    i10tri        ../engine/source/interfaces/intsort/i10tri.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../engine/share/message_module/message_mod.F
!||====================================================================
       SUBROUTINE i10buce(
     1   X       ,IRECT   ,NSV     ,NMN     ,NRTM    ,
     2   NSN     ,NCONT   ,CAND_E  ,CAND_N  ,GAP     ,
     3   NOINT   ,II_STOK ,TZINF   ,MAXBOX  ,MINBOX  ,
     4   NB_N_B  ,ESHIFT  ,BMINMA  ,MWAG    ,ILD     ,
     7   NCONTACT,NSNROLD ,STFN    ,NIN     ,IGAP    ,
     8   GAP_S   ,NSNR    ,RENUM   ,STF     ,GAP_M   ,
     9   GAPMIN  ,GAPMAX  ,I_MEM   ,INTHEAT, IDT_THERM, NODADT_THERM)
C============================================================================
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"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "warn_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NMN, NRTM, NSN, NOINT, NIN, IGAP, NSNR, NSNROLD
      INTEGER IRECT(4,*),NSV(*),MWAG(*)
      INTEGER CAND_E(*),CAND_N(*),RENUM(*)
      INTEGER ILD,NB_N_B,ESHIFT,NCONTACT,NCONT,I_MEM,II_STOK 
      INTEGER ,INTENT(IN) :: INTHEAT
      INTEGER, INTENT(IN) :: IDT_THERM
      INTEGER, INTENT(IN) :: NODADT_THERM
C     REAL
      my_real
     .   gap,tzinf,maxbox,minbox,gapmin, gapmax, bminma(6)
      my_real
     .   x(3,*),stfn(*), gap_s(*), stf(*), gap_m(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I_ADD_MAX
      PARAMETER (I_ADD_MAX = 1001)
      INTEGER I_ADD, IP0, IP1, MAXSIZ, 
     . ADD(2,I_ADD_MAX)
C     REAL
      my_real
     .        XYZM(6,I_ADD_MAX-1),MARGE
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
C----- sorting by boxes of elements and nodes
C
C-----------------------------------------------
C if we don't have enough memory for the stacks we restart the sorting
C by incrementing nb_n_b (number of nodes per finished box)
C
C     POINTEUR  NOM                            TAILLE
C     P0........CAND_A:address of N in CAND_N  NSN + 3[+ NSNROLD in the SPMD case]
C     P1........Elt Bas Pile                   NRTM
C     P2........Elt PILE                       2*NRTM
C     P21.......BPN                            NSN
C     P22.......PN                             NSN
C     P31.......ADDI                           2*I_ADD_MAX
      maxsiz = 3*(nrtm+100)
      ip0 = 1
      ip1 = ip0 + nsn + nsnrold + 3
C
C
C-----initialization of addresses and x,y,z
C
C     ADDE     ADDN     X      Y      Z
C     1        1        XMIN   YMIN   ZMIN
C     1        1        XMAX   YMAX   ZMAX
C
      add(1,1) = 0
      add(2,1) = 0
      add(1,2) = 0
      add(2,2) = 0
      i_add = 1
      xyzm(1,i_add) = bminma(4)
      xyzm(2,i_add) = bminma(5)
      xyzm(3,i_add) = bminma(6)
      xyzm(4,i_add) = bminma(1)
      xyzm(5,i_add) = bminma(2)
      xyzm(6,i_add) = bminma(3)
      i_mem = 0
C
C
C-----beginning of the sorting phase
C 
C       SEPARER B ET N EN TWO
      marge = tzinf-gap  ! it is indeed the margin
      CALL i10tri(
     1   add     ,nsn     ,renum    ,nsnr     ,nrtm     ,    
     2   irect   ,x       ,xyzm     ,igap     ,gap      ,
     3   i_add   ,nsv     ,maxsiz   ,ii_stok  ,cand_n   ,  
     4   cand_e  ,ncontact,noint    ,tzinf    ,maxbox   ,
     5   minbox  ,i_mem   ,nb_n_b   ,i_add_max,mwag(ip0),
     6   eshift  ,nsnrold ,stf      ,stfn     ,gap_s    ,
     7   gap_m   ,gapmin  ,gapmax   ,marge    ,nin      ,
     8   intheat, idt_therm, nodadt_therm)
C---------------------------------
C     I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
C     I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
C     I_MEM = 3 ==> TROP NIVEAUX PILE 
      IF (i_mem == 2) RETURN
      IF(i_mem==1)THEN
        nb_n_b = nb_n_b + 1
        IF ( nb_n_b > ncont) THEN
          CALL ancmsg(msgid=85,anmode=aninfo,
     .                i1=noint)
          CALL arret(2)
        ENDIF
        ild = 1
      ELSEIF(i_mem==2) THEN
        IF(debug(1)>=1) THEN
          iwarn = iwarn+1
#include "lockon.inc"
          WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
          WRITE(iout,*)' **WARNING INTERFACE NB:',noint
          WRITE(iout,*)'       TOO MANY POSSIBLE IMPACTS'
          WRITE(iout,*)'       SIZE OF INFLUENCE ZONE IS'
          WRITE(iout,*)'       MULTIPLIED BY 0.75'
#include "lockoff.inc"
        ENDIF
        tzinf = three_over_4*tzinf
C do not decrease the box size
C        MINBOX= THREE_OVER_4*MINBOX
C        MAXBOX= THREE_OVER_4*MAXBOX
        IF( tzinf<=gap ) THEN
          CALL ancmsg(msgid=85,anmode=aninfo,
     .                i1=noint)
          CALL arret(2)
        ENDIF
        ild = 1
      ELSEIF(i_mem==3)THEN
        nb_n_b = nb_n_b + 1
        IF ( nb_n_b > ncont) THEN
          CALL ancmsg(msgid=90,anmode=aninfo,
     .                i1=noint)
          CALL arret(2)
        ENDIF
        ild = 1
      ENDIF
C
      RETURN
      END