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       -----------------------------------------------------
!||    element_mod    ../common_source/modules/elements/element_mod.F90
!||    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
      use element_mod , only : nixs
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 in 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,I_ADD,I_STOK,L,NB_NC,NB_EC,CONT 
      INTEGER ADD(2,I_ADD_MAX) ,PROV_N(MVSIZ),PROV_E(MVSIZ),
     .        BPE(MAXSIZ/3), PE(MAXSIZ), BPN(MAXSIZS/3), PN(MAXSIZS)
C in all rigor maxsiz = nme and maxsizs = nmes+nmesr
      my_real
     .        XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX
C------------------------------------
C---------------------------------
C     init of main boxes
C---------------------------------
C
      nb_ec = nme
      DO l=1,nb_ec
        i = l + esh_t
        bpe(l) = i
      ENDDO
C
Cinitialization 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
      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 Non -local candidate account in SPMD
C
      DO i = nmes+1, nmes+nmesr
        nb_nc = nb_nc + 1
        bpn(nb_nc) = i
      ENDDO
C
C-----------------------------------------------
C     loop over boxes
C-----------------------------------------------
      DO WHILE (cont==1)
C-----------------------------------------------
C       Decouption of space by 2 following x y or 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       end or error test
C-----------------------------------------------
C     CONT = 0  ==> FIN
C     CONT = -1 ==> PAS ASSEZ DE MEMOIRE PILE
C     CONT = -2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
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       -----------------------------------------------------
!||    element_mod   ../common_source/modules/elements/element_mod.F90
!||    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
      use element_mod , only : nixs
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   Routine Role:
C   ===================
C   classifies the bpe elts and bpn nodes into two zones
C   > or < to a boundary determined here and outputs everything
C   in bpe, hpe, and 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          ARRAY OF FACETTES TO SORT      E/S
C                  and of the result on the max side
C     PE           ARRAY OF FACETTES              S
C                  RESULTAT COTE MIN
C     BPN          SORTED NODES ARRAY        E/S
C                  and of the result on the max side
C     PN           NODES ARRAY S
C                  RESULTAT COTE MIN
C     ADD(2,*)     ARRAY OF ADRESSES              E/S 
C          1.......ADRESSES NODES C          2.......ADRESSES ELEMENTS
C     ZYZM(6,*)     ARRAY OF 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,*)   ARRAY OF COORD ELEM MIN/MAX    E
C     X(3,*)       COORDONNEES NODALES               E
C     NB_NC        NUMBER OF CANDIDATE NODES        E/S
C     NB_EC        NUMBER OF CANDIDATE ELEMENTS           E/S
C     i_add position in the i/o address table
C     NSV          NOS SYSTEMES DES NODES E
C     Xmax larger abcisse existing e
C     XMAX largest order.existing E
C     Xmax larger existing side E
C     MAXSIZ       TAILLE MEMOIRE MAX POSSIBLE       E
C     i_stok storage level of pairs
C                                CANDIDATES impact    E/S
C     CAND_N       boites resultats nodes C     CAND_E       adresses des boites resultat elements
C                  COUPLES NODES,ELT CANDIDATES
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,l,ncand_prov,lesl
C     REAL
      my_real
     .   dx,dy,dz,dsup,seuil
C
C-----------------------------------------------------------
C
C
C    1- TEST ARRET = BOITE VIDE
C                    BOITE TROP PETITE 
C                    BOITE NE CONTENANT QU'ONE NODE C                    No More Available Memory
C
Cmemory exceeded test
C
      IF(add(2,i_add)+nb_ec>maxsiz) THEN
C       no more space in the main elements stack, boxes too small
        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       no more space in the secondary elements stack, boxes too small
        cont = -1
        RETURN
      ENDIF
C
Cempty box test
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
Cend of branch test
C      1.1- storage of candidate node(s) and corresponding elts
C          remove the useless ones
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   necessary qd nb_nc <= nb_n_b or dsup <minbox and 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       ! SPMD complementary part
                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- sorting phase on the median according to the largest 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               stored in the pn stack
                nb_ncn1 = nb_ncn1 + 1
                addnn = addnn + 1
                pn(addnn) = les
              ENDIF
            END IF
           ENDDO
           IF(nspmd>1)THEN           ! SPMD complementary part
#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                  stored in the pn stack
                   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           ! SPMD complementary part
#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 no secondary elements in the second box
#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 no secondary elements in the first box
#include "vectorize.inc"
           DO i=1,nb_ec
            le = bpe(i)
            IF(eminx(dir,le)-tzinf<seuil) THEN
C             stored in the pe stack
              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             stored in the pe stack
              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
Cfill the min of the next box and the max of the current one
          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     increment the descent level before exiting
          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     end of sorting test
C-------------------------------------------------------------------------
      IF (i_add==1) THEN
        cont = 0
        RETURN
      ENDIF
C-----------------------------------------------------------
C
C    3- end of branch or empty box
C                    
C-----------------------------------------------------------
C-------------------------------------------------------------------------
C       decrement the descent level before restarting
C-------------------------------------------------------------------------
      i_add = i_add - 1
C-------------------------------------------------------------------------
C         need to copy the bottom of the stacks into the corresponding bottom_of_stack
C         before descending into the neighboring branch
C-------------------------------------------------------------------------
C     3.1- PILE DES NODES 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     duplicate search
      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