i17tri.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/.
!||====================================================================
!||    i17tri         ../engine/source/interfaces/int17/i17tri.F
!||--- called by ------------------------------------------------------
!||    i17buce        ../engine/source/interfaces/int17/i17buce.F
!||    i17buce_pena   ../engine/source/interfaces/int17/i17buce.f
!||--- calls      -----------------------------------------------------
!||    ancmsg         ../engine/source/output/message/message.F
!||    arret          ../engine/source/system/arret.F
!||    i17cut         ../engine/source/interfaces/int17/i17tri.F
!||    i17sto         ../engine/source/interfaces/int17/i17tri.F
!||--- uses       -----------------------------------------------------
!||    message_mod    ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i17tri(
     2      TZINF  ,IXS     ,IXS16    ,IXS20    ,NELEM    ,
     3      NELES  ,MAXSIZ  ,CAND_N   ,CAND_E   ,MINBOX   ,                       
     5      CONT   ,NB_N_B  ,EMINX    ,I_STOK_GLOB,NME    ,
     6      ITASK  ,NOINT   ,X        ,V        ,A        ,
     7      MX_CAND,EMINXS  ,ESH_T    ,MAXSIZS  ,I_ADD_MAX,
     8      XYZM   ,NMES    ,NMESR    ,NIN      )
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   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
ctmp+1
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     PARAMETER (I_ADD_MAX = 1001) declare dans I17BUCE
      INTEGER I_ADD_MAX, NMESR, NIN,
     .        MAXSIZ,NB_N_B,I_STOK_GLOB,NME,NMES ,ITASK,NOINT ,MX_CAND,
     .        IXS(NIXS,*),IXS16(8,*),
     .        NELES(*),CAND_N(*),CAND_E(*),NELEM(*),IXS20(12,*),ESH_T,
     .        MAXSIZS  
C     REAL
      my_real
     .   x(3,*),v(3,*),a(3,*),eminx(6,*),eminxs(6,*),
     .   minbox,tzinf,
     .   xyzm(6,i_add_max-1)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,I_ADD,I_STOK,L,NB_NC,NB_EC,CONT,NE 
      INTEGER ADD(2,I_ADD_MAX) ,PROV_N(MVSIZ),PROV_E(MVSIZ),
     .        BPE(MAXSIZ/3), PE(MAXSIZ), BPN(MAXSIZS/3), PN(MAXSIZS)
C en toute rigueur MAXSIZ = NME et MAXSIZS = NMES+NMESR
      my_real
     .        XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX
C------------------------------------
C---------------------------------
C     Init des boite main
C---------------------------------
C
      nb_ec = nme
      DO l=1,nb_ec
        i = l + esh_t
        bpe(l) = i
      ENDDO
C
C-----INITIALISATION DES ADRESSES ET X,Y,Z
C
C     ADDE     ADDN     X      Y      Z
C     1        1        XMIN   YMIN   ZMIN
C     1        1        XMAX   YMAX   ZMAX
      i_stok = 0
      add(1,1) = 0
      add(2,1) = 0
      add(1,2) = 0
      add(2,2) = 0
      i_add = 1
      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)
      nb_nc = 0
      DO i=1,nmes
C
        IF(eminxs(4,i)>xmin.AND.
     .     eminxs(5,i)>ymin.AND.
     .     eminxs(6,i)>zmin.AND.
     .     eminxs(1,i)<xmax.AND.
     .     eminxs(2,i)<ymax.AND.
     .     eminxs(3,i)<zmax)THEN
          nb_nc=nb_nc+1
          bpn(nb_nc) = i
        ENDIF
      ENDDO
C
C Prise en compte candidats non locaux en SPMD
C
      DO i = nmes+1, nmes+nmesr
        nb_nc = nb_nc + 1
        bpn(nb_nc) = i
      ENDDO
C
C-----------------------------------------------
C     Boucle sur les boites
C-----------------------------------------------
      DO WHILE (cont==1)
C-----------------------------------------------
C       Decoupage de l'espace en 2 suivant X Y ou Z
C-----------------------------------------------
        CALL i17cut(
     1      bpe        ,pe      ,bpn      ,pn       ,add      ,
     2      x          ,nb_nc   ,nb_ec    ,xyzm     ,i_add    ,
     3      neles      ,maxsiz  ,cand_n   ,cand_e   ,minbox   ,                       
     4      cont       ,nb_n_b  ,i_add_max,eminx    ,nelem    ,
     5      i_stok     ,ixs     ,ixs16    ,ixs20    ,tzinf    ,
     6      i_stok_glob,prov_n  ,prov_e   ,v        ,a        ,
     7      mx_cand    ,eminxs  ,maxsizs  ,nmes     ,nin      )
      ENDDO
C-----------------------------------------------
C       test de fin ou d'erreur
C-----------------------------------------------
C     CONT = 0  ==> FIN
C     CONT = -1 ==> PAS ASSEZ DE MEMOIRE PILE
C     CONT = -2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
C     CONT = -3 ==> TROP NIVEAUX PILE 
      IF(cont==0)THEN
        IF(i_stok/=0)CALL i17sto(
     1      i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
     2      cont  ,mx_cand    )
      ENDIF
      IF(cont==-1) THEN
          CALL ancmsg(msgid=86,anmode=aninfo,i1=noint)
          CALL arret(2)
      ELSEIF(cont==-2) THEN
          CALL ancmsg(msgid=86,anmode=aninfo,i1=noint)
          CALL arret(2)
      ELSEIF(cont==-3)THEN
          CALL ancmsg(msgid=90,anmode=aninfo,i1=noint)
          CALL arret(2)
      ENDIF
C
C
      RETURN
      END
!||====================================================================
!||    i17cut    ../engine/source/interfaces/int17/i17tri.F
!||--- called by ------------------------------------------------------
!||    i17tri    ../engine/source/interfaces/int17/i17tri.F
!||--- calls      -----------------------------------------------------
!||    i17sto    ../engine/source/interfaces/int17/i17tri.f
!||--- uses       -----------------------------------------------------
!||    tri7box   ../engine/share/modules/tri7box.F
!||====================================================================
      SUBROUTINE i17cut(
     1      BPE        ,PE      ,BPN      ,PN       ,ADD      ,
     2      X          ,NB_NC   ,NB_EC    ,XYZM     ,I_ADD    ,
     3      NELES      ,MAXSIZ  ,CAND_N   ,CAND_E   ,MINBOX   ,                       
     4      CONT       ,NB_N_B  ,I_ADD_MAX,EMINX    ,NELEM    ,
     5      I_STOK     ,IXS     ,IXS16    ,IXS20    ,TZINF    ,
     6      I_STOK_GLOB,PROV_N  ,PROV_E   ,V        ,A        ,
     7      MX_CAND    ,EMINXS  ,MAXSIZS  ,NMES     ,NIN      )
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-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_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      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     EMINX(6,*)   TABLEAU DES COORD ELEM MIN/MAX    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                  COUPLES NOEUDS,ELT CANDIDATS
C     MINBOX       TAILLE MIN BUCKET
C
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_GLOB,I_STOK,MX_CAND,NIN,
     .        NB_N_B,I_ADD_MAX,CONT  ,IXS(NIXS,*),IXS16(8,*),
     .        ADD(2,*),BPE(*),PE(*),BPN(*),PN(*),
     .        CAND_N(*),CAND_E(*),NELEM(*),NELES(*),
     .        PROV_N(*)  ,PROV_E(*)  ,IXS20(12,*),MAXSIZS, NMES
C     REAL
      my_real
     .   X(3,*),V(3,*),A(3,*),XYZM(6,*),EMINX(6,*),EMINXS(6,*),
     .   MINBOX,TZINF    
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,
     .        nes,ne,le,les,k,l,ncand_prov,n16,n20,lesl
C     REAL
      my_real
     .   dx,dy,dz,dsup,seuil,xx,yy,zz
C
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-------------------TEST SUR MEMOIRE DEPASSEE------------
C
      IF(add(2,i_add)+nb_ec>maxsiz) THEN
C       PLUS DE PLACE DANS LA PILE DES ELEMENTS MAINS BOITES TROP PETITES
        cont = -1
ctmp+++
c       WRITE(istdo,*)'MAXSIZ = ',MAXSIZ
c       WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
c       WRITE(istdo,*)'NB_EC = ',NB_EC
ctmp---
        RETURN
      ENDIF
      IF(add(1,i_add)+nb_nc>maxsizs) THEN
C       PLUS DE PLACE DANS LA PILE DES ELEMENTS SECONDS BOITES TROP PETITES
        cont = -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.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<=128) THEN
          ncand_prov = nb_ec*nb_nc
        ELSE
          ncand_prov = 129
        ENDIF
C
        IF(dsup<minbox.OR.nb_nc<=nb_n_b.OR.ncand_prov<=128)THEN
C   necessaire qd NB_NC<=NB_N_B ou DSUP<MINBOX et NB_EC+NB_NC>128
            ncand_prov = nb_ec*nb_nc
            DO l=1,ncand_prov
              i = 1+(l-1)/nb_nc
              j = l-(i-1)*nb_nc
              le = bpe(i)
              les = bpn(j)
              ne  = nelem(le)
              IF(les<=nmes)THEN        ! candidat local
                nes = neles(les)
                IF(ne/=nes.AND.
     .             eminxs(4,les)>eminx(1,le)-tzinf.AND.
     .             eminxs(5,les)>eminx(2,le)-tzinf.AND.
     .             eminxs(6,les)>eminx(3,le)-tzinf.AND.
     .             eminxs(1,les)<eminx(4,le)+tzinf.AND.
     .             eminxs(2,les)<eminx(5,le)+tzinf.AND.
     .             eminxs(3,les)<eminx(6,le)+tzinf)THEN
                  i_stok = i_stok + 1
                  prov_n(i_stok) = les
                  prov_e(i_stok) = le
                  IF(i_stok==mvsiz-1)CALL i17sto(
     1               i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
     2               cont  ,mx_cand    )
                  IF(cont==-2)RETURN
                ENDIF
              ELSE       ! partie complementaire SPMD
                lesl = les-nmes
                IF(xrem(4,lesl)>eminx(1,le)-tzinf.AND.
     .             xrem(5,lesl)>eminx(2,le)-tzinf.AND.
     .             xrem(6,lesl)>eminx(3,le)-tzinf.AND.
     .             xrem(1,lesl)<eminx(4,le)+tzinf.AND.
     .             xrem(2,lesl)<eminx(5,le)+tzinf.AND.
     .             xrem(3,lesl)<eminx(6,le)+tzinf)THEN
                  i_stok = i_stok + 1
                  prov_n(i_stok) = les
                  prov_e(i_stok) = le
                  IF(i_stok==mvsiz-1)CALL i17sto(
     1               i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
     2               cont  ,mx_cand    )
                  IF(cont==-2)RETURN
                ENDIF
              END IF
            ENDDO 
C-----------------------------------------------------------
        ELSE
C-----------------------------------------------------------
C
C
C    2- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
C                    
C                   
C-----------------------------------------------------------
C
C    2.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))*half
C
C    2.2- DIVISER LES ELEMENTS SECONDS EN TWO ZONES 
C
          nb_ncn= 0
          nb_ncn1= 0
          addnn= add(1,i_add)
          nb_ecn= 0
          addne= add(2,i_add)
#include "vectorize.inc"
           DO i=1,nb_nc
            les = bpn(i)
            IF(les<=nmes)THEN
              IF(eminxs(dir,les)<seuil) THEN
C               ON STOCKE DANS LA PILE PN
                nb_ncn1 = nb_ncn1 + 1
                addnn = addnn + 1
                pn(addnn) = les
              ENDIF
            END IF
           ENDDO
           IF(nspmd>1)THEN           ! partie complementaire SPMD
#include "vectorize.inc"
             DO i=1,nb_nc
               les = bpn(i)
               IF(les>nmes)THEN
                 lesl = les-nmes
                 IF(xrem(dir,lesl)<seuil) THEN
C                  ON STOCKE DANS LA PILE PN
                   nb_ncn1 = nb_ncn1 + 1
                   addnn = addnn + 1
                   pn(addnn) = les
                 END IF
               END IF
             END DO
           END IF
C
#include "vectorize.inc"
           DO i=1,nb_nc
            les = bpn(i)
            IF(les<=nmes)THEN
              IF(eminxs(dir+3,les)>=seuil) THEN
C               ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
                nb_ncn = nb_ncn + 1
                bpn(nb_ncn) = les
              ENDIF
            ENDIF
           ENDDO
           IF(nspmd>1)THEN           ! partie complementaire SPMD
#include "vectorize.inc"
             DO i=1,nb_nc
               les = bpn(i)
               IF(les>nmes)THEN
                 lesl = les-nmes
                 IF(xrem(dir+3,lesl)>=seuil) THEN
C                  ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
                   nb_ncn = nb_ncn + 1
                   bpn(nb_ncn) = les
                 ENDIF
               ENDIF
             ENDDO
           END IF
C
C    2.3- DIVISER LES ELEMENTS MAINS
C
          nb_ecn= 0
          addne= add(2,i_add)
          IF(nb_ncn1==0) THEN
C pas d'elements seconds dans la deuxieme boite
#include "vectorize.inc"
           DO i=1,nb_ec
            le = bpe(i)
            IF(eminx(dir+3,le)+tzinf>=seuil) THEN
C             ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
              nb_ecn = nb_ecn + 1
              bpe(nb_ecn) = le
            ENDIF
           ENDDO
          ELSEIF(nb_ncn==0) THEN
C pas d'elements seconds dans la premiere boite
#include "vectorize.inc"
           DO i=1,nb_ec
            le = bpe(i)
            IF(eminx(dir,le)-tzinf<seuil) THEN
C             ON STOCKE DANS LA PILE PE
              addne = addne + 1
              pe(addne) = le
            ENDIF
           ENDDO
          ELSE
#include "vectorize.inc"
           DO i=1,nb_ec
            le = bpe(i)
            IF(eminx(dir,le)-tzinf<seuil) THEN
C             ON STOCKE DANS LA PILE PE
              addne = addne + 1
              pe(addne) = le
            ENDIF
            IF(eminx(dir+3,le)+tzinf>=seuil) THEN
C             ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
              nb_ecn = nb_ecn + 1
              bpe(nb_ecn) = le
            ENDIF
           ENDDO
          ENDIF
C
C    2.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
          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+1>=i_add_max) THEN
            cont = -3
            RETURN
          ENDIF
C=======================================================================
          cont=1
ctmp+++
c       WRITE(istdo,*)'CONT = ',CONT
c       WRITE(istdo,*)'I_ADD = ',I_ADD
c       WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
c       WRITE(istdo,*)'NB_EC = ',NB_EC
c       WRITE(istdo,*)'NB_NC = ',NB_NC
c       WRITE(istdo,*)'dir seuil = ',dir, seuil
c       WRITE(istdo,*)'Xmin = ',XYZM(1,I_ADD)
c       WRITE(istdo,*)'Ymin = ',XYZM(2,I_ADD)
c       WRITE(istdo,*)'Zmin = ',XYZM(3,I_ADD)
c       WRITE(istdo,*)'Xmax = ',XYZM(4,I_ADD)
c       WRITE(istdo,*)'Ymax = ',XYZM(5,I_ADD)
c       WRITE(istdo,*)'Zmax = ',XYZM(6,I_ADD)
ctmp---
          RETURN
C=======================================================================
        ENDIF
      ENDIF
C-------------------------------------------------------------------------
C     TEST FIN DU TRI
C-------------------------------------------------------------------------
      IF (i_add==1) THEN
        cont = 0
        RETURN
      ENDIF
C-----------------------------------------------------------
C
C    3- FIN DE BRANCHE ou BOITE VIDE
C                    
C-----------------------------------------------------------
C-------------------------------------------------------------------------
C       on decremente le niveau de descente avant de recommencer
C-------------------------------------------------------------------------
      i_add = i_add - 1
C-------------------------------------------------------------------------
C         IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
C         AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
C-------------------------------------------------------------------------
C     3.1- PILE DES NOEUDS
C
      nb_nc = add(1,i_add+1) - add(1,i_add)
      DO i=1,nb_nc
        bpn(i) = pn(add(1,i_add)+i)
      ENDDO
C
C     3.2- PILE DES ELEMENTS
C
      nb_ec = add(2,i_add+1) - add(2,i_add)
      DO i=1,nb_ec
        bpe(i) = pe(add(2,i_add)+i)
      ENDDO
C=======================================================================
      cont=1
      RETURN
C=======================================================================
      END
!||====================================================================
!||    i17sto         ../engine/source/interfaces/int17/i17tri.F
!||--- called by ------------------------------------------------------
!||    i17cut         ../engine/source/interfaces/int17/i17tri.F
!||    i17tri         ../engine/source/interfaces/int17/i17tri.F
!||--- uses       -----------------------------------------------------
!||    icontact_mod   ../engine/share/modules/icontact_mod.F
!||====================================================================
      SUBROUTINE i17sto(
     1     I_STOK,I_STOK_GLOB,PROV_N  ,CAND_N,PROV_E,CAND_E,
     2     CONT  ,MX_CAND    )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE icontact_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   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER I_STOK,I_STOK_GLOB,CONT  ,MX_CAND,
     .        PROV_N(*),CAND_N(*),PROV_E(*),CAND_E(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J_STOK_GLOB
      INTEGER LE,LES,NEXT,IC,J
C-----------------------------------------------
C     Recherche de doublons
      J=0
 
#include "lockon.inc"
 
      DO I=1,I_STOK
        LES = PROV_N(I)
        LE  = PROV_E(I)
        NEXT = ADCHAINE(LES)
        IF(NEXT == 0)THEN
            J=J+1
            PROV_N(J) = LES
            PROV_E(J) = LE
            MX_AD = MX_AD + 1
            IF(MX_AD > MX_CAND)THEN
              CONT = -2
#include "lockoff.inc"
              RETURN
            ENDIF
            ADCHAINE(LES)   = MX_AD
            CHAINE(1,MX_AD) = LE
            CHAINE(2,MX_AD) = 0
            goto 200
        ENDIF
 100    continue
        IC = NEXT
        IF(LE == CHAINE(1,IC))goto 200
          NEXT = CHAINE(2,IC)
          IF(NEXT /= 0)goto 100
            J=J+1
            PROV_N(J) = LES
            PROV_E(J) = LE
            MX_AD = MX_AD + 1
            IF(MX_AD > MX_CAND)THEN
              CONT = -2
#include "lockoff.inc"
              RETURN
            ENDIF
            CHAINE(2,IC)    = MX_AD
            CHAINE(1,MX_AD) = LE
            CHAINE(2,MX_AD) = 0
 200    continue
      ENDDO
      I_STOK = J
 
        J_STOK_GLOB = I_STOK_GLOB
        IF(I_STOK_GLOB + I_STOK<=MX_CAND)THEN
          I_STOK_GLOB = I_STOK_GLOB + I_STOK
        ELSE
          CONT = -2
        ENDIF
#include "lockoff.inc"
      IF(CONT==-2)RETURN
C
      DO I=1,I_STOK
        CAND_N(I+J_STOK_GLOB)=PROV_N(I)
        CAND_E(I+J_STOK_GLOB)=PROV_E(I)
      ENDDO
C
      I_STOK = 0
C-----------------------------------------------
      RETURN
      END