i24tri.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/.
!||====================================================================
!||    i24tri                 ../starter/source/interfaces/inter3d1/i24tri.F
!||--- called by ------------------------------------------------------
!||    i24buc1                ../starter/source/interfaces/inter3d1/i24buc1.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    i24fic_getn            ../starter/source/interfaces/inter3d1/i24surfi.F
!||    i24s1s2                ../starter/source/interfaces/inter3d1/i24buc1.F
!||    i7cmp3                 ../starter/source/interfaces/inter3d1/i7cmp3.F
!||    i7cor3                 ../starter/source/interfaces/inter3d1/i7cor3.F
!||    i7dst3                 ../starter/source/interfaces/inter3d1/i7dst3.F
!||    i7dstk                 ../starter/source/interfaces/inter3d1/i7dstk.F
!||    i7pen3                 ../starter/source/interfaces/inter3d1/i7pen3.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i24tri(
     1      BPE    ,PE    ,BPN   ,PN    ,ADD   ,
     2      IRECT  ,X     ,NB_NC ,NB_EC ,XYZM  ,
     3      I_ADD  ,NSV   ,I_AMAX,XMAX  ,YMAX  ,
     4      ZMAX   ,MAXSIZ,I_STOK,I_MEM ,NB_N_B,
     5      CAND_N ,CAND_E,NSN   ,NOINT ,TZINF ,
     6      MAXBOX ,MINBOX,STF   ,STFN  ,J_STOK,
     7      MULTIMP,ISTF  ,ITAB  ,GAP   ,GAP_S ,
     8      GAP_M  ,IGAP  ,GAPMIN,GAPMAX,MARGE ,
     9      GAP_S_L,GAP_M_L,ID   ,TITR  ,ILEV  ,
     A      NBINFLG,MBINFLG ,MVOISN    ,IXS    ,
     B      IXS10  ,IXS16 ,IXS20 , IPARTNS,IPEN0,
     C      INACTI ,MSEGTYP,MARGE_SH,NRTM,IRTSE,IS2SE,
     D      IX1,IX2,IX3,IX4,NSVG,
     E      X1,X2,X3,X4,Y1,
     F      Y2,Y3,Y4,Z1,Z2,
     G      Z3,Z4,XI,YI,ZI,
     H      X0,Y0,Z0,STIF,NX1,
     I      NY1,NZ1,NX2,NY2,NZ2,
     J      NX3,NY3,NZ3,NX4,NY4,
     K      NZ4,P1,P2,P3,P4,
     L      LB1,LB2,LB3,LB4,LC1,
     M      LC2,LC3,LC4,PENE,PROV_N,
     N      PROV_E,N11,N21,N31,DGAPLOAD,
     O      S_KREMNODE,S_REMNODE,KREMNODE,REMNODE,
     P      TAG_REMOVED_NODE,FLAG_REMOVED_NODE)
#ifndef hypermesh_lib
      USE message_mod
#endif
      USE names_and_titles_mod , ONLY : nchartitle
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "vect07_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NB_NC,NB_EC,I_ADD,MAXSIZ,I_STOK,J_STOK,I_MEM,ISTF
      INTEGER I_BID, I_AMAX,NB_N_B, NOINT, NSN,MULTIMP, IGAP
      INTEGER ADD(2,0:*),IRECT(4,*),BPE(*),PE(*),BPN(*),PN(*)
      INTEGER NSV(*),CAND_N(*),CAND_E(*), ITAB(*),NBINFLG(*),MBINFLG(*),
     *        ILEV,MVOISN(4,*),IPARTNS(*),IPEN0,INACTI,NRTM
      INTEGER IXS(NIXS,*), IXS10(6,*), IXS16(8,*), IXS20(12,*),IRTSE(*),IS2SE(*)
C     REAL
      my_real
     .   x(3,*),xyzm(6,*),tzinf,dbuc,stf(*),stfn(*),
     .   maxbox,minbox, xmax, ymax, zmax,
     .   gap, gap_s(*), gap_m(*),
     .   gapmin, gapmax, marge, gapsmx, bgapsmx,
     .   gap_s_l(*),gap_m_l(*),marge_sh
      my_real , INTENT(IN) :: dgapload
      INTEGER ID,MSEGTYP(*)
      LOGICAL, INTENT(in) :: FLAG_REMOVED_NODE !< flag to remove some S node from the list of candidates
      INTEGER, INTENT(in) :: S_KREMNODE !< size of KREMNODE
      INTEGER, INTENT(in) :: S_REMNODE !< size of REMNODE   
      INTEGER, DIMENSION(S_KREMNODE), INTENT(in) :: KREMNODE 
      INTEGER, DIMENSION(S_REMNODE), INTENT(in) :: REMNODE
      INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: TAG_REMOVED_NODE
      CHARACTER(LEN=NCHARTITLE) :: TITR
      INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) ::PROV_N,PROV_E
      INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0,stif
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n11,n21,n31,pene
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx1,ny1,nz1
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx2,ny2,nz2
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx3,ny3,nz3
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx4,ny4,nz4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: p1,p2,p3,p4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lb1,lb2,lb3,lb4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lc1,lc2,lc3,lc4
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NB_NCN,NB_ECN,ADDNN,ADDNE,IPOS,I,IP,J
      INTEGER INF,SUP,DIR,N1,N2,N3,N4,NN,NE,INS
      INTEGER SKIP,NS,NS1,NS2,NSE
      INTEGER :: FIRST,LAST
      INTEGER :: IJK
C     REAL
      my_real
     .   bid,dx,dy,dz,dsup,seuil,xmx,xmn,gapsmax,
     .   gapv(mvsiz),marge_e
C-----------------------------------------------
C   ROLE DE LA ROUTINE:
C   ===================
C   CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
C   > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
C   DANS bpe,hpe, et bpn,hpn
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C
C     NOM          DESCRIPTION                       E/S
C
C     BPE          TABLEAU DES FACETTES A TRIER      E/S
C                  ET DU RESULTAT COTE MAX            
C     PE           TABLEAU DES FACETTES              S
C                  RESULTAT COTE MIN
C     BPN          TABLEAU DES NOEUDS A TRIER        E/S
C                  ET DU RESULTAT COTE MAX            
C     PN           TABLEAU DES NOEUDS                S
C                  RESULTAT COTE MIN
C     ADD(2,*)     TABLEAU DES ADRESSES              E/S 
C          1.......ADRESSES NOEUDS
C          2.......ADRESSES ELEMENTS
C     ZYZM(6,*)     TABLEAU DES XYZMIN               E/S 
C          1.......XMIN BOITE
C          2.......YMIN BOITE
C          3.......ZMIN BOITE
C          4.......XMAX BOITE
C          5.......YMAX BOITE
C          6.......ZMAX BOITE
C     IRECT(4,*)   TABLEAU DES CONEC FACETTES        E
C     X(3,*)       COORDONNEES NODALES               E
C     NB_NC        NOMBRE DE NOEUDS CANDIDATS        E/S
C     NB_EC        NOMBRE D'ELTS CANDIDATS           E/S
C     I_ADD        POSITION DANS LE TAB DES ADRESSES E/S
C     NSV          NOS SYSTEMES DES NOEUDS           E
C     XMAX         plus grande abcisse existante     E
C     XMAX         plus grande ordonn. existante     E
C     XMAX         plus grande cote    existante     E
C     MAXSIZ       TAILLE MEMOIRE MAX POSSIBLE       E
C     I_STOK       niveau de stockage des couples
C                                candidats impact    E/S
C     CAND_N       boites resultats noeuds
C     CAND_E       adresses des boites resultat elements
C                  MULTIMP*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
C                  COUPLES NOEUDS,ELT CANDIDATS
C     NOINT        NUMERO USER DE L'INTERFACE
C     TZINF        TAILLE ZONE INFLUENCE
C     MAXBOX       TAILLE MAX BUCKET
C     MINBOX       TAILLE MIN BUCKET
C=======================================================================
C
C
C    1- TEST ARRET = BOITE VIDE
C                    BOITE TROP PETITE 
C                    BOITE NE CONTENANT QU'ONE NOEUD
C                    PLUS DE MEMOIRE DISPONIBLE
C
C-----------------------------------------------------------
C
C      IF(MEMX>ADD(2,1)+NB_EC)THEN
C        WRITE(ISTDO,*)' *******MEM MAX=',MEMX
C        MEMX=-1
C      ELSEIF(MEMX/=-1)THEN
C        MEMX=ADD(2,1)+NB_EC
C      ENDIF
C--------------------TEST SUR BOITE VIDES-------------- 
C
      IF(nb_ec==0.OR.nb_nc==0) THEN
C       write(6,*)" BOITE VIDE"
C       IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
C       AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
        CALL i7dstk(i_add,nb_nc,nb_ec,add,bpn,pn,bpe,pe)
        RETURN
      ENDIF
C
C-------------------TEST SUR FIN DE BRANCHE / MEMOIRE DEPASSEE------------
C
      dx = xyzm(4,i_add) - xyzm(1,i_add)
      dy = xyzm(5,i_add) - xyzm(2,i_add)
      dz = xyzm(6,i_add) - xyzm(3,i_add)
      dsup= max(dx,dy,dz)
C
      IF(add(2,1)+nb_ec>=maxsiz) THEN
C       PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
        IF ( nb_n_b == numnod) THEN
#ifndef HYPERMESH_LIB
          CALL ancmsg(msgid=83,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=id,
     .                c1=titr)
#endif
        ENDIF
        i_mem = 1
        RETURN
      ENDIF
      IF(dsup<minbox.OR.
     .   nb_nc<=nb_n_b.AND.dsup<maxbox.OR.   
     .   nb_nc<=nb_n_b.AND.nb_ec==1) THEN
C
C       write(6,*)" NOUVELLE BOITE "
C       1- STOCKAGE DU OU DES  NOEUD CANDIDAT ET DES ELTS CORRESP.
C       VIRER LES INUTILES
        DO i=1,nb_ec
            ne = bpe(i)
            ! --------------
            ! do not take into account node_id = REMNODE(i)
            IF(flag_removed_node) THEN
              first = kremnode(ne)+1
              last = kremnode(ne+1)
              DO ijk=first,last
                IF(remnode(ijk)<=numnod) tag_removed_node(remnode(ijk)) = 1
              ENDDO
            ENDIF
            ! --------------
            n1=irect(1,ne) 
            n2=irect(2,ne) 
            n3=irect(3,ne) 
            n4=irect(4,ne) 
            IF (msegtyp(ne)==0.OR.msegtyp(ne)>nrtm) THEN
             marge_e = marge
            ELSE
             marge_e = marge_sh
            END IF 
            DO j=1,nb_nc
              nn=nsv(bpn(j))
C-----------------  
C--------   not sure if use Inacti----
C              INS = 1
C              IF (INACTI > 0)        
C     .        CALL INSOLBOX(X    ,MVOISN(1,NE),MVOISN(2,NE),NOINT ,IXS,
C     .                     IXS10 ,IXS16   ,IXS20  ,NN    ,GAP    ,
C     .                     MVOISN(3,NE),IPARTNS(BPN(J)),IPEN0,INS    )
              IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4) THEN
C Fictive Nodes to filter  
                skip=0
                IF(nn > numnod)THEN
                  ns=nn-numnod
                  CALL i24fic_getn(ns      ,irtse   ,is2se   ,nse    ,
     +                             ns1     ,ns2     )
                  IF(ns1 == n1 .OR. ns2 == n1) skip=1
                  IF(ns1 == n2 .OR. ns2 == n2) skip=1
                  IF(ns1 == n3 .OR. ns2 == n3) skip=1
                  IF(ns1 == n4 .OR. ns2 == n4) skip=1
 
                  IF(skip==0) THEN
                    IF(flag_removed_node) THEN
                      first = kremnode(ne)+1
                      last = kremnode(ne+1)
                      DO ijk=first,last
                        IF(remnode(ijk)==nn) skip = 1
                      ENDDO
                    ENDIF
                  ENDIF
                ELSE
                  ! --------------
                  ! S node must be remove from the list of candidates if TAG_REMOVED_NODE = 1
                  IF(flag_removed_node) THEN
                      IF(tag_removed_node(nn)==1) skip = 1
                  ENDIF
                  ! --------------
                ENDIF
 
                IF (skip==0)THEN 
                 j_stok = j_stok + 1
                 prov_n(j_stok) = bpn(j)
                 prov_e(j_stok) = ne
                 IF(j_stok==nvsiz) THEN
                   lft = 1
                   llt = nvsiz
                   nft = 0
                   j_stok = 0
                   CALL i7cor3(x    ,irect,nsv  ,prov_e ,prov_n,
     .                        stf  ,stfn ,gapv ,igap   ,gap   ,
     .                        gap_s,gap_m,istf ,gapmin ,gapmax,
     .                        gap_s_l,gap_m_l  ,zero   ,ix1     ,ix2   ,
     5                        ix3    ,ix4    ,nsvg,x1      ,x2    ,
     6                        x3     ,x4     ,y1  ,y2      ,y3    ,
     7                        y4     ,z1     ,z2  ,z3      ,z4    ,
     8                        xi     ,yi     ,zi  ,stif    ,dgapload,
     9                        llt)
                   CALL i7dst3(ix3,ix4,x1 ,x2 ,x3 ,
     1                  x4 ,y1 ,y2 ,y3 ,y4 ,
     2                  z1 ,z2 ,z3 ,z4 ,xi ,
     3                  yi ,zi ,x0 ,y0 ,z0 ,
     4                  nx1,ny1,nz1,nx2,ny2,
     5                  nz2,nx3,ny3,nz3,nx4,
     6                  ny4,nz4,p1 ,p2 ,p3 ,
     7                  p4 ,lb1,lb2,lb3,lb4,
     8                  lc1,lc2,lc3,lc4,llt)
 
                   CALL i7pen3(marge_e,gapv,n11,n21,n31,
     1                  pene ,nx1 ,ny1,nz1,nx2,
     2                  ny2  ,nz2 ,nx3,ny3,nz3,
     3                  nx4  ,ny4 ,nz4,p1 ,p2 ,
     4                  p3   ,p4,llt)
 
                   IF (ilev==2) CALL i24s1s2(prov_n,prov_e,nbinflg,mbinflg,pene)
                   IF(i_stok+nvsiz<multimp*nsn) THEN
                     CALL i7cmp3(i_stok,cand_e  ,cand_n,1,pene,
     1                  prov_n,prov_e)
                   ELSE
                     i_bid = 0
                     CALL i7cmp3(i_bid,cand_e,cand_n,0,pene,
     1                  prov_n,prov_e)
                    IF(i_stok+i_bid<multimp*nsn) THEN
                      CALL i7cmp3(i_stok,cand_e,cand_n,1,pene,
     1                  prov_n,prov_e)
                    ELSE
                      i_mem = 2
c                      CALL ANSTCKI(NOINT)
c                      CALL ANCWARN(103,ANINFO_BLIND_2)
                      RETURN
                    ENDIF
                  ENDIF
                ENDIF
C               write(6,*)"Noeud candidat",BPN(J)
C               write(6,*)"Element  candidat",NE
               ENDIF
              ENDIF  
            ENDDO
 
            ! --------------
            ! flush to 0
            IF(flag_removed_node) THEN
              first = kremnode(ne)+1
              last = kremnode(ne+1)
              DO ijk=first,last
                IF(remnode(ijk)<=numnod) tag_removed_node(remnode(ijk)) = 0
              ENDDO
            ENDIF
            ! --------------
        ENDDO 
C       IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
C       AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
        CALL i7dstk(i_add,nb_nc,nb_ec,add,bpn,pn,bpe,pe)
        RETURN
      ENDIF
C
C-----------------------------------------------------------
C
C
C    2- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
C                    
C                   
C-----------------------------------------------------------
C
C
C    1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
C
      dir = 1
      IF(dy==dsup) THEN
        dir = 2
      ELSE IF(dz==dsup) THEN
        dir = 3
      ENDIF
      seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))/2
C
C    2- DIVISER LES NOEUDS EN TWO ZONES 
C
      nb_ncn= 0
      addnn= add(1,1)
      inf = 0
      sup = 0
      IF(igap==0)THEN
       DO i=1,nb_nc
        IF(x(dir,nsv(bpn(i)))<seuil) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          addnn = addnn + 1
          pn(addnn) = bpn(i)
          inf = 1
        ELSE
          nb_ncn = nb_ncn + 1
          bpn(nb_ncn) = bpn(i)
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
          sup = 1
        ENDIF
       END DO
      ELSE
       gapsmx  = zero
       bgapsmx = zero
       DO i=1,nb_nc
        IF(x(dir,nsv(bpn(i)))<seuil) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          addnn = addnn + 1
          pn(addnn) = bpn(i)
          gapsmx = max(gapsmx,gap_s(bpn(i)))
          inf = 1
        ELSE
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
          nb_ncn = nb_ncn + 1
          bpn(nb_ncn) = bpn(i)
          bgapsmx = max(bgapsmx,gap_s(bpn(i)))
          sup = 1
        ENDIF
       END DO
      END IF
 
CC
CC    3- DIVISER LES ELEMENTS 
CC
C      NB_ECN= 0
C      ADDNE= ADD(2,1)
C      SEUILI = SEUIL-TZINF
C      SEUILS = SEUIL+TZINF
C      DO 85 I=1,NB_EC
C        INF = 0
C        SUP = 0
C        DO 80 J=1,4
C          IP = IRECT(J,BPE(I))
C          IF(X(DIR,IP)<SEUILS) THEN
C            INF = 1
C            IF(SUP==1) GOTO 81
C          ENDIF
C          IF(X(DIR,IP)>=SEUILI) THEN
C            SUP = 1
C            IF(INF==1) GOTO 81
C          ENDIF
C   80   CONTINUE
C
C   81   CONTINUE
C        IF(INF==1) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
C          ADDNE = ADDNE + 1
C          PE(ADDNE) = BPE(I)
C        ENDIF
C        IF(SUP==1) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
C          NB_ECN = NB_ECN + 1
C          BPE(NB_ECN) = BPE(I)
C        ENDIF
C   85 CONTINUE
C
C    3- DIVISER LES ELEMENTS
C
C 2 LIGNES PROV POUR TEST
C      INF = 1
C      SUP = 1
C
      nb_ecn= 0
      addne= add(2,1)
      IF(igap==0)THEN
       DO i=1,nb_ec
        xmx = max(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
     .            x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
     .      + tzinf
        xmn = min(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
     .            x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
     .      - tzinf
        IF(xmn<seuil.AND.inf==1) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          addne = addne + 1
          pe(addne) = bpe(i)
        ENDIF
        IF(xmx>=seuil.AND.sup==1) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
          nb_ecn = nb_ecn + 1
          bpe(nb_ecn) = bpe(i)
        ENDIF
       ENDDO
      ELSE       
       DO i=1,nb_ec
          ne = bpe(i)
          IF (msegtyp(ne)==0.OR.msegtyp(ne)>nrtm) THEN
           marge_e = marge
          ELSE
           marge_e = marge_sh
          END IF 
        xmn = min(x(dir,irect(1,ne)),x(dir,irect(2,ne)),
     .            x(dir,irect(3,ne)),x(dir,irect(4,ne)))
     .      - max(min(gapsmx+gap_m(ne),gapmax),gapmin)+dgapload-marge_e
        IF(xmn<seuil.AND.inf==1) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          addne = addne + 1
          pe(addne) = bpe(i)
        ENDIF
        xmx = max(x(dir,irect(1,ne)),x(dir,irect(2,ne)),
     .            x(dir,irect(3,ne)),x(dir,irect(4,ne)))
     .      + max(min(bgapsmx+gap_m(ne),gapmax),gapmin)+dgapload+marge_e
        IF(xmx>=seuil.AND.sup==1) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
          nb_ecn = nb_ecn + 1
          bpe(nb_ecn) = bpe(i)
        ENDIF
       ENDDO
      END IF
C
C    4- REMPLIR LES TABLEAUX D'ADRESSES
C
      add(1,2) = addnn
      add(2,2) = addne
C-----on remplit les min de la boite suivante et les max de la courante
C     (i.e. seuil est un max pour la courante)
C     on va redescendre et donc on definit une nouvelle boite
C     on remplit les max de la nouvelle boite
C     initialises dans i7buc1 a 1.E30 comme ca on recupere
C     soit XMAX soit le max de la boite
      xyzm(1,i_add+1) = xyzm(1,i_add) 
      xyzm(2,i_add+1) = xyzm(2,i_add)
      xyzm(3,i_add+1) = xyzm(3,i_add)
      xyzm(4,i_add+1) = xyzm(4,i_add)
      xyzm(5,i_add+1) = xyzm(5,i_add)
      xyzm(6,i_add+1) = xyzm(6,i_add)
      xyzm(dir,i_add+1) = seuil
      xyzm(dir+3,i_add) = seuil
C
      nb_nc = nb_ncn
      nb_ec = nb_ecn
C     on incremente le niveau de descente avant de sortir
      i_add = i_add + 1
      IF(i_add>=1000) THEN
C       TROP NIVEAUX PILE ON VAS LES PRENDRE PLUS GRANDES...
        IF ( nb_n_b == numnod) THEN
#ifndef HYPERMESH_LIB
          CALL ancmsg(msgid=83,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=id,
     .                c1=titr)
#endif
        ENDIF
        i_mem = 1
        RETURN
      ENDIF
C
C     ce return n'est atteint que dans le cas ok = 0
      RETURN
      END