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 of the routine:
C   ===================
C   classify BPE elements and BPN nodes in two zones
C   > or < to a boundary determined here and output all
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      => Local
C                  and from the result max side
C     PE           ARRAY OF FACETTES              => Local
C                  RESULTAT COTE MIN
C     BPN          SORTED NODES ARRAY        => Local
C                  and from the result max side
C     PN           NODES ARRAY => Local
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     IRECT(4,*)   ARRAY OF CONEC FACETTES        E
C     X(3,*)       COORDONNEES NODALES               E
C     NB_NC        NUMBER OF CANDIDATE NODES        => Local
C     NB_EC        NUMBER OF CANDIDATE ELEMENTS           => Local
C     I_ADD        position in the table of i/o addresses
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 for pairs
C                                CANDIDATES impact    E/S
C     ADNSTK       current address in the node box
C     CAND_N       boites resultats nodes C     ADESTK       current address in the element box
C     CAND_E       adresses des boites resultat elements
C                  MULNSN = MULTIMP*NSN maximum size now allowed for the
C                  COUPLES NODES,ELT CANDIDATES
C     NOINT        INTERFACE USER NUMBER
C     TZINF        TAILLE ZONE INFLUENCE
C     MAXBOX       TAILLE MAX BUCKET
C     MINBOX       TAILLE MIN BUCKET
C
C     Prov_n Provisional Cand_n (static variable in i7tri)
C     PROV_E       CAND_E provisoire (variable static in 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),
     .        
C BPE: Use on nrtm and not nrtm + 100 rigorously (here 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,
     .      
     .   
     .   smoins,splus,xx
C REMNODE
      INTEGER, DIMENSION(:), ALLOCATABLE :: TAGREMNODE
      INTEGER DELNOD,M
 
C-----------------------------------------------
C initial construction phase of BPE and BPN moved from 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 copy of segment and node numbers in BPE and BPN
C
      nb_ec = 0
      DO i=1,nrtm
C We do not retain the Destruit facets
        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 optimization // search for nodes within xmin xmax of the
C processor elements
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 Non -local candidate account in 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 in SPMD, for inacti or IFQ, recovers old numbering of non-local candidates
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- sorting phase on the median according to the largest 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 NODES 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         we store at the bottom of the BP stack
          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         we store at the bottom of the BP stack
          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- divide the 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         we store at the bottom of the BP stack
          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         we store at the bottom of the BP stack
          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-----we fill the min of the next box and the max of the current one
C     (i.e. THRESHOLD is a max for the current one)
C     We're going to go down and so we define a new box
C     we fill the max of the new box
C     initialises in i7buc1 a 1.E30 comme ca on recupere
C     either XMAX or the max of the box
      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     we increment the descent level before exiting
      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 NODE C                    No More Memory Available
C
C-------------------test for memory exceeded------------
C
      IF(add(2,i_add)+nb_ec>maxsiz) THEN
C       no more room in the stack of elements boxes too small
         WRITE(6,*) __line__,__line__
 
        i_mem = 1
        RETURN
      ENDIF
C
C--------------------test for empty boxes--------------
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 for end of branch ------------
C       1- storage of candidate node(s) and corresponding elements
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<=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       empty box or
C       end of branch
C       we decrement the descent level before restarting
C-------------------------------------------------------------------------
      i_add = i_add - 1
      IF (i_add/=0) THEN
C-------------------------------------------------------------------------
C         the bottom of the stacks must be copied into corresponding stack bottoms
C         before going back down into the adjacent branch
C-------------------------------------------------------------------------
          CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
C=======================================================================
          GOTO 200
C=======================================================================
      ENDIF
C-------------------------------------------------------------------------
C     end of sorting
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