i7tri.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/.
!||====================================================================
!||    i7tri           ../engine/source/interfaces/intsort/i7tri.f
!||--- called by ------------------------------------------------------
!||    i7buce          ../engine/source/interfaces/intsort/i7buce.F
!||--- calls      -----------------------------------------------------
!||    i7dstk          ../engine/source/interfaces/intsort/i7dstk.F
!||    i7sto           ../engine/source/interfaces/intsort/i7sto.F
!||    spmd_oldnumcd   ../engine/source/mpi/interfaces/spmd_i7tool.F
!||--- uses       -----------------------------------------------------
!||    tri7box         ../engine/share/modules/tri7box.F
!||====================================================================
      SUBROUTINE i7tri(
     1      ADD   ,NSN    ,RENUM  ,NSNR     ,ISZNSNR  ,
     2      IRECT ,X      ,STF    ,STFN     ,XYZM     ,
     3      I_ADD ,NSV    ,MAXSIZ ,II_STOK  ,CAND_N   ,
     4      CAND_E,MULNSN ,NOINT  ,TZINF    ,MAXBOX   ,
     5      MINBOX,I_MEM  ,NB_N_B ,I_ADD_MAX,ESHIFT   ,
     6      INACTI,IFQ    ,CAND_A ,CAND_P   ,IFPEN    ,
     7      NRTM  ,NSNROLD,IGAP,GAP      ,GAP_S    ,
     8      GAP_M ,GAPMIN ,GAPMAX ,MARGE    ,CURV_MAX ,
     9      NIN   ,GAP_S_L,GAP_M_L,INTTH   ,DRAD  ,ITIED    ,
     A      CAND_F ,KREMNOD  ,REMNOD  ,FLAGREMNODE,DGAPLOAD,
     B      INTHEAT,IDT_THERM,NODADT_THERM)
C=======================================================================
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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"
c     parameter setting the size for the vector (orig version is 128)
      INTEGER NVECSZ 
      parameter(nvecsz = mvsiz)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "ige3d_c.inc"
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      => Local
C                  ET DU RESULTAT COTE MAX            
C     PE           TABLEAU DES FACETTES              => Local
C                  RESULTAT COTE MIN
C     BPN          TABLEAU DES NOEUDS A TRIER        => Local
C                  ET DU RESULTAT COTE MAX            
C     PN           TABLEAU DES NOEUDS                => Local
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        => Local
C     NB_EC        NOMBRE D'ELTS CANDIDATS           => Local
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     ADNSTK       adresse courante dans la boite des noeuds
C     CAND_N       boites resultats noeuds
C     ADESTK       adresse courante dans la boite des elements
C     CAND_E       adresses des boites resultat elements
C                  MULNSN = 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     PROV_N       CAND_N provisoire (variable static dans i7tri)
C     PROV_E       CAND_E provisoire (variable static dans i7tri)
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER I_ADD,MAXSIZ,I_MEM,ESHIFT,NSN,ISZNSNR,NRTM,NSNROLD,
     .        MULNSN,NB_N_B,NOINT,I_ADD_MAX,INACTI,IFQ,NSNR,IGAP,NIN,
     .        ADD(2,*),IRECT(4,*),
     .        NSV(*),CAND_N(*),CAND_E(*),CAND_A(*),IFPEN(*),RENUM(*),
     .        INTTH,II_STOK,ITIED
      INTEGER KREMNOD(*),REMNOD(*),FLAGREMNODE
      INTEGER, INTENT(IN) :: INTHEAT
      INTEGER, INTENT(IN) :: IDT_THERM
      INTEGER, INTENT(IN) :: NODADT_THERM
C     REAL
      my_real
     .   x(3,*),xyzm(6,*),cand_p(*),stf(*),stfn(*),gap_s(*),gap_m(*),
     .   tzinf,maxbox,minbox,marge,gap,gapmin,gapmax,
     .   curv_max(*),gap_s_l(*),gap_m_l(*),cand_f(*)
      my_real , INTENT(IN) :: drad,dgapload
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NB_NC,NB_EC,
     .        n1,n2,n3,n4,nn,ne,k,l,ncand_prov,j_stok,ii,jj,
     .        prov_n(2*mvsiz),prov_e(2*mvsiz),
     .        tn1(nvecsz),tn2(nvecsz),tn3(nvecsz),tn4(nvecsz),
C BPE : utilise sur NRTM et non NRTM + 100 en toute rigueur (ici MAXSIZ = NRTM + 100)
     .        bpe(maxsiz/3),pe(maxsiz),bpn(nsn+nsnr),pn(nsn+nsnr),
     .        oldnum(isznsnr),iadd
C     REAL
      my_real
     .   aaa,
     .   dx,dy,dz,dsup,trhreshold, xx1, xx2, xx3, xx4,
     .   xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, bgapsmx, gapl,
     .   txx1(3,nvecsz), txx2(3,nvecsz), txx3(3,nvecsz), txx4(3,nvecsz),
     .   txmax(nvecsz),txmin(nvecsz),tymax(nvecsz),
     .   tymin(nvecsz),tzmax(nvecsz),tzmin(nvecsz),smoins,splus,xx
C REMNODE
      INTEGER, DIMENSION(:), ALLOCATABLE :: TAGREMNODE
      INTEGER DELNOD,M
 
C-----------------------------------------------
C Phase initiale de construction de BPE et BPN deplacee de I7BUCE => I7TRI
C
 
      IF(flagremnode == 2) ALLOCATE(tagremnode(numnod+numfakenodigeo))
 
      xmin = xyzm(1,i_add)
      ymin = xyzm(2,i_add)
      zmin = xyzm(3,i_add)
      xmax = xyzm(4,i_add)
      ymax = xyzm(5,i_add)
      zmax = xyzm(6,i_add)
C
C     DRAD = ZERO
C
C Copie des nos de segments et de noeuds dans BPE ET BPN
C
      nb_ec = 0
      DO i=1,nrtm
C on ne retient pas les facettes detruites
        IF(stf(i)/=zero)THEN
          nb_ec = nb_ec + 1
          bpe(nb_ec) = i
        ENDIF
      ENDDO
 
      IF(igap==3) THEN
        iadd = 10
      ENDIF
C
C Optimisation // recherche les noeuds compris dans xmin xmax des 
C elements du processeur
C
      nb_nc = 0
      DO i=1,nsn
        j=nsv(i)
        IF(stfn(i)/=zero) THEN
 
         IF(x(1,j)>=xmin.AND.x(1,j)<=xmax.AND.
     .     x(2,j)>=ymin.AND.x(2,j)<=ymax.AND.
     .     x(3,j)>=zmin.AND.x(3,j)<=zmax)THEN
 
          nb_nc=nb_nc+1
          bpn(nb_nc) = i
         ENDIF
        ENDIF
      ENDDO
C
C Prise en compte candidats non locaux en SPMD
C
      DO i = nsn+1, nsn+nsnr
        IF( xrem(1,i-nsn)<xmin) cycle
        IF( xrem(1,i-nsn)>xmax) cycle
        IF( xrem(2,i-nsn)<ymin) cycle
        IF( xrem(2,i-nsn)>ymax) cycle
        IF( xrem(3,i-nsn)<zmin) cycle
        IF( xrem(3,i-nsn)>zmax) cycle
        nb_nc = nb_nc + 1
        bpn(nb_nc) = i
      ENDDO
C
C En SPMD, pour inacti ou IFQ, retrouve ancienne numerotation des candidats non locaux
C
      IF(nspmd>1.AND.
     +  (inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
     +   itied/=0)) THEN
        CALL spmd_oldnumcd(renum,oldnum,isznsnr,nsnrold,intheat,idt_therm,nodadt_therm)
      END IF
C
      j_stok = 0
      GOTO 200
C=======================================================================
 100  CONTINUE
C=======================================================================
C-----------------------------------------------------------
C
C
C    1- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
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
      smoins = xyzm(dir,i_add)
      splus  = xyzm(dir+3,i_add)
      trhreshold =(smoins+splus)*half
C
C    2- DIVISER LES NOEUDS EN TWO ZONES
C
      nb_ncn= 0
      nb_ncn1= 0
      addnn= add(1,i_add)
C
      gapsmx = zero
      DO i=1,nb_nc
       j = bpn(i)
       IF(j <= nsn) THEN
        xx = x(dir,nsv(j))
        IF(xx < trhreshold) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          nb_ncn1 = nb_ncn1 + 1
          addnn = addnn + 1
          pn(addnn) = j
          IF(igap /=0) gapsmx = max(gapsmx,gap_s(j))
          smoins = max(smoins,xx)
        ENDIF
       ENDIF
      ENDDO
      DO i=1,nb_nc
       j = bpn(i)
       IF(j > nsn) THEN
        xx = xrem(dir,j-nsn)
        IF(xx < trhreshold) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          nb_ncn1 = nb_ncn1 + 1
          addnn = addnn + 1
          pn(addnn) = j
          IF(igap/=0) gapsmx = max(gapsmx,xrem(9,j-nsn))
          smoins = max(smoins,xx)
        ENDIF
       ENDIF
      ENDDO
      bgapsmx = zero
      DO i=1,nb_nc
       j = bpn(i)
       IF(j <= nsn) THEN
        xx = x(dir,nsv(j))
        IF(xx >= trhreshold) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
          nb_ncn = nb_ncn + 1
          bpn(nb_ncn) = j
          IF(igap/=0) bgapsmx = max(bgapsmx,gap_s(j))
          splus = min(splus,xx)
        ENDIF
       ENDIF
      ENDDO
      DO i=1,nb_nc
       j = bpn(i)
       IF(j > nsn) THEN
        xx = xrem(dir,j-nsn)
        IF(xx >= trhreshold) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
          nb_ncn = nb_ncn + 1
          bpn(nb_ncn) = j
          IF(igap /= 0) bgapsmx = max(bgapsmx,xrem(9,j-nsn))
          splus = min(splus,xx)
        ENDIF
       ENDIF
      ENDDO
C
C    3- DIVISER LES ELEMENTS
C
      nb_ecn= 0
      addne= add(2,i_add)
      IF(nb_ncn1==0) THEN
        DO i=1,nb_ec
         ne = bpe(i)
         xx1=x(dir, irect(1,ne))
         xx2=x(dir, irect(2,ne))
         xx3=x(dir, irect(3,ne))
         xx4=x(dir, irect(4,ne))
         IF(igap == 0) THEN
           aaa = tzinf+curv_max(ne)
         ELSEIF(igap == 3) THEN
           aaa =  max(drad,dgapload+min(max(bgapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
     +       +marge+curv_max(ne)
         ELSE
           aaa = max(drad,dgapload+min(max(bgapsmx+gap_m(ne),gapmin),gapmax))
     +       +marge+curv_max(ne)
         ENDIF
         xmax = max(xx1,xx2,xx3,xx4) + aaa
         IF(xmax >= splus) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
          nb_ecn = nb_ecn + 1
          bpe(nb_ecn) = ne
         ENDIF
        ENDDO
       ELSEIF(nb_ncn == 0) THEN 
#include "vectorize.inc"
        DO i=1,nb_ec
         ne = bpe(i)
         xx1=x(dir, irect(1,ne))
         xx2=x(dir, irect(2,ne))
         xx3=x(dir, irect(3,ne))
         xx4=x(dir, irect(4,ne))
         IF( igap == 0 ) THEN
          aaa = -tzinf-curv_max(ne)
         ELSEIF(igap == 3) THEN
          aaa = -max(drad,dgapload+min(max(gapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
     +          -marge-curv_max(ne)
         ELSE
          aaa = -max(drad,dgapload+min(max(gapsmx+gap_m(ne),gapmin),gapmax))
     -           -marge-curv_max(ne)
         ENDIF
         xmin = min(xx1,xx2,xx3,xx4) + aaa
 
         IF(xmin < smoins) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          addne = addne + 1
          pe(addne) = ne
         ENDIF
        ENDDO
       ELSE
        DO i=1,nb_ec
         ne = bpe(i)
         xx1=x(dir, irect(1,ne))
         xx2=x(dir, irect(2,ne))
         xx3=x(dir, irect(3,ne))
         xx4=x(dir, irect(4,ne))
         IF( igap == 0 ) THEN
           aaa=-tzinf-curv_max(ne)
         ELSEIF(igap == 3) THEN
           aaa=  - max(drad,dgapload+min(max(gapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
     +       -marge-curv_max(ne)
         ELSE
           aaa=  -max(drad,dgapload+min(max(gapsmx+gap_m(ne),gapmin),gapmax))
     -       -marge-curv_max(ne)
         ENDIF
         xmin =  min(xx1,xx2,xx3,xx4) + aaa 
         IF(xmin < smoins) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          addne = addne + 1
          pe(addne) = ne
         ENDIF
        ENDDO
C
        DO i=1,nb_ec
         ne = bpe(i)
         xx1=x(dir, irect(1,ne))
         xx2=x(dir, irect(2,ne))
         xx3=x(dir, irect(3,ne))
         xx4=x(dir, irect(4,ne))
         IF( igap == 0) THEN
            aaa =tzinf+curv_max(ne)
         ELSEIF( igap==3 ) THEN
            aaa=  max(drad,dgapload+min(max(bgapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
     +       +marge+curv_max(ne)
         ELSE
          aaa = max(drad,dgapload+min(max(bgapsmx+gap_m(ne),gapmin),gapmax))
     +       +marge+curv_max(ne)
         ENDIF
         xmax = max(xx1,xx2,xx3,xx4) + aaa
 
         IF(xmax >= splus) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
          nb_ecn = nb_ecn + 1
          bpe(nb_ecn) = ne
         ENDIF
       ENDDO
      ENDIF !NBNC1
C
C    4- REMPLIR LES TABLEAUX D'ADRESSES
C
      add(1,i_add+1) = addnn
      add(2,i_add+1) = addne
C-----on remplit les min de la boite suivante et les max de la courante
C     (i.e. TRHRESHOLD 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) = splus
      xyzm(dir+3,i_add) = smoins
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+1>=i_add_max) THEN
c       WRITE(6,*) __LINE__,__LINE__
        i_mem = 3
        RETURN
      ENDIF
C=======================================================================
 200  CONTINUE
C=======================================================================
C-----------------------------------------------------------
C
C
C    2- TEST ARRET = BOITE VIDE
C                    BOITE TROP PETITE
C                    BOITE NE CONTENANT QU'ONE NOEUD
C                    PLUS DE MEMOIRE DISPONIBLE
C
C-------------------TEST SUR MEMOIRE DEPASSEE------------
C
      IF(add(2,i_add)+nb_ec>maxsiz) THEN
C       PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
         WRITE(6,*) __line__,__line__
 
        i_mem = 1
        RETURN
      ENDIF
C
C--------------------TEST SUR BOITE VIDES--------------
C
      IF(nb_ec/=0.AND.nb_nc/=0) THEN
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
C-------------------TEST SUR FIN DE BRANCHE ------------
C       1- STOCKAGE DU OU DES  NOEUD CANDIDAT ET DES ELTS CORRESP.
C          VIRER LES INUTILES
C
C       NCAND_PROV=NB_EC*NB_NC
C   NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
C
        IF(nb_ec+nb_nc<=nvecsz) THEN
          ncand_prov = nb_ec*nb_nc
        ELSE
          ncand_prov = nvecsz+1
        ENDIF
        IF(dsup<minbox.OR.(nb_nc<=nb_n_b)
     &     .OR.(ncand_prov<=nvecsz)) THEN
          ncand_prov = nb_ec*nb_nc
 
          IF(flagremnode==2) THEN
            DO i=1,numnod+numfakenodigeo
              tagremnode(i) = 0
            ENDDO
          ENDIF
 
          DO k=1,ncand_prov,nvsiz
            DO l=k,min(k-1+nvsiz,ncand_prov)
             i = 1+(l-1)/nb_nc
             j = l-(i-1)*nb_nc
             ne = bpe(i)
             n1=irect(1,ne)
             n2=irect(2,ne)
             n3=irect(3,ne)
             n4=irect(4,ne)
 
             IF(flagremnode==2) THEN
               DO m= kremnod(2*(ne-1)+1)+1, kremnod(2*(ne-1)+2)
                 tagremnode(remnod(m)) = 1
               ENDDO
             ENDIF
             jj = bpn(j)
             IF( jj<=nsn ) THEN
               IF( igap == 0 ) THEN
                 tz = tzinf+curv_max(ne)
               ELSEIF( igap == 3 ) THEN
                 tz = max(drad,dgapload+max(min(gap_s_l(jj)+gap_m_l(ne),gapmax),gapmin)
     .           +marge+curv_max(ne))
               ELSE
                 tz=max(drad,dgapload+max(min(gap_s(jj)+gap_m(ne),gapmax),gapmin)
     +           +marge+curv_max(ne))
               ENDIF
             ELSE
               ii = jj-nsn
               IF( igap == 0 ) THEN
                 tz = tzinf+curv_max(ne)
               ELSEIF( igap == 3 ) THEN
                 tz = max(drad,dgapload+max(min(xrem(iadd,ii)+gap_m_l(ne)
     .           ,gapmax),gapmin))+marge+curv_max(ne)
               ELSE
                 tz = max(drad,dgapload+max(min(xrem(9,ii)+gap_m(ne),gapmax),gapmin))
     +           +marge+curv_max(ne)
               ENDIF
             ENDIF
             xx1=x(1, n1)
             xx2=x(1, n2)
             xx3=x(1, n3)
             xx4=x(1, n4)
             xmax=max(xx1,xx2,xx3,xx4)+tz
             xmin=min(xx1,xx2,xx3,xx4)-tz
             xx1=x(2, n1)
             xx2=x(2, n2)
             xx3=x(2, n3)
             xx4=x(2, n4)
             ymax=max(xx1,xx2,xx3,xx4)+tz
             ymin=min(xx1,xx2,xx3,xx4)-tz
             xx1=x(3, n1)
             xx2=x(3, n2)
             xx3=x(3, n3)
             xx4=x(3, n4)
             zmax=max(xx1,xx2,xx3,xx4)+tz
             zmin=min(xx1,xx2,xx3,xx4)-tz
             IF(jj<=nsn) THEN
 
               IF(flagremnode==2) THEN
                 IF(tagremnode(nsv(jj)) == 1) cycle
               ENDIF
               nn=nsv(jj)
               IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
     &           x(1,nn)>xmin.AND.x(1,nn)<xmax.AND.
     &           x(2,nn)>ymin.AND.x(2,nn)<ymax.AND.
     &           x(3,nn)>zmin.AND.x(3,nn)<zmax ) THEN
                 j_stok = j_stok + 1
                 prov_n(j_stok) = jj
                 prov_e(j_stok) = ne
               ENDIF
             ELSE
               ii = jj-nsn
               IF(flagremnode==2) THEN
                 DO m= kremnod(2*(ne-1)+2) + 1,  kremnod(2*(ne-1)+3)
                   IF(remnod(m) == -irem(2,ii) ) THEN
                     delnod = delnod + 1
                     EXIT
                   ENDIF
                 ENDDO
                 IF(delnod /= 0) cycle
               ENDIF
               IF(xrem(1,ii)>xmin.AND.
     &            xrem(1,ii)<xmax.AND.
     &            xrem(2,ii)>ymin.AND.
     &            xrem(2,ii)<ymax.AND.
     &            xrem(3,ii)>zmin.AND.
     &            xrem(3,ii)<zmax ) THEN
                 j_stok = j_stok + 1
                 prov_n(j_stok) = jj
                 prov_e(j_stok) = ne
               ENDIF
             ENDIF
            ENDDO ! L=K,MIN(K-1+NVSIZ,NCAND_PROV)
 
            IF(j_stok>=nvsiz)THEN
              CALL i7sto(
     1             nvsiz,irect   ,x     ,nsv   ,ii_stok,
     2             cand_n,cand_e ,mulnsn,noint ,marge  ,
     3             i_mem ,prov_n ,prov_e,eshift,inacti ,
     4             ifq   ,cand_a ,cand_p,ifpen ,nsn    ,
     5             oldnum,nsnrold,igap  ,gap   ,gap_s  ,
     6             gap_m ,gapmin ,gapmax,curv_max,nin  ,
     7             gap_s_l,gap_m_l,intth,drad,itied    ,
     8             cand_f,dgapload)
               IF(i_mem==2) THEN
                 RETURN
               ENDIF
               j_stok = j_stok-nvsiz
#include "vectorize.inc"
               DO j=1,j_stok
                 prov_n(j) = prov_n(j+nvsiz)
                 prov_e(j) = prov_e(j+nvsiz)
               ENDDO
            ENDIF ! J_STOK >= NVSIZ
 
          ENDDO ! LOOP OVER POSSIBLE CANDIDATES
        ELSE
C=======================================================================
          GOTO 100
C=======================================================================
        ENDIF
      ENDIF
C-------------------------------------------------------------------------
C       BOITE VIDE OU
C       FIN DE BRANCHE
C       on decremente le niveau de descente avant de recommencer
C-------------------------------------------------------------------------
      i_add = i_add - 1
      IF (i_add/=0) THEN
C-------------------------------------------------------------------------
C         IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
C         AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
C-------------------------------------------------------------------------
          CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
C=======================================================================
          GOTO 200
C=======================================================================
      ENDIF
C-------------------------------------------------------------------------
C     FIN DU TRI
C-------------------------------------------------------------------------
      IF(j_stok/=0)CALL i7sto(
     1              j_stok,irect  ,x     ,nsv   ,ii_stok,
     2              cand_n,cand_e ,mulnsn,noint ,marge  ,
     3              i_mem ,prov_n ,prov_e,eshift,inacti ,
     4              ifq   ,cand_a ,cand_p,ifpen ,nsn    ,
     5              oldnum,nsnrold,igap  ,gap   ,gap_s  ,
     6              gap_m ,gapmin ,gapmax,curv_max,nin  ,
     7              gap_s_l,gap_m_l,intth,drad,itied    ,
     8              cand_f ,dgapload)
C-------------------------------------------------------------------------
      IF(flagremnode==2) THEN
        DEALLOCATE(tagremnode)
      ENDIF
      RETURN
      END