i11tri.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/.
!||====================================================================
!||    i11tri                 ../starter/source/interfaces/inter3d1/i11tri.F
!||--- called by ------------------------------------------------------
!||    i11buc1                ../starter/source/interfaces/inter3d1/i11buc1.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    i11sto                 ../starter/source/interfaces/inter3d1/i11sto.F
!||    i7dstk                 ../starter/source/interfaces/inter3d1/i7dstk.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i11tri(
     1      BPE   ,PE    ,BPN   ,PN    ,ADD,
     2      IRECTS,X     ,NB_SC ,NB_MC ,XYZM,
     3      I_ADD ,IRECTM,I_AMAX,ISTOP  ,
     4      MAXSIZ,I_STOK,I_MEM ,NB_N_B,IADFIN,
     5      CAND_S,CAND_M,NSN   ,NOINT ,TZINF ,
     6      MAXBOX,MINBOX,J_STOK,ADDCM,CHAINE,
     7      PROV_S,PROV_M,II_STOK,MULTIMP,ID,TITR)
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
C============================================================================
C  cette routine est appelee par : I11BUC1(/inter3d1/i11buc1.F)
C----------------------------------------------------------------------------
C  cette routine appelle : I11STO(/inter3d1/i11sto.F)
C                          I7DSTK(/inter3d1/i7dstk.F)
C                          ARRET(/sortie1/arret.F)
C============================================================================
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NB_SC,NB_MC,I_ADD,MAXSIZ,I_STOK,J_STOK,I_MEM
      INTEGER I_BID, I_AMAX,NB_N_B, NOINT, NSN,MULTIMP,ISTOP,
     .        IADFIN,II_STOK
      INTEGER ADD(2,0:*),IRECTS(2,*),IRECTM(2,*),BPE(*),PE(*)
      INTEGER CAND_S(*),CAND_M(*),BPN(*),PN(*)
      INTEGER ADDCM(*),CHAINE(*)
      INTEGER PROV_S(2*MVSIZ),PROV_M(2*MVSIZ)
      my_real
     .   x(3,*),xyzm(6,*),tzinf,dbuc,
     .   maxbox,minbox
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE) :: TITR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NB_SCN1,NB_MCN1,NB_SCN,NB_MCN,ADDNN,ADDNE,IPOS,
     .        I,IP,J,K,L
      INTEGER INF,SUP,DIR,N1,N2,NN1,NN2,NN,NE,MEMX,NCAND_PROV
      my_real
     .   dx,dy,dz,dsup,seuil,xmx,xmn,xx1,xx2,xmin, xmax
CC      integer idb1,idb2,idb3,idb4
CC      save idb1,idb2,idb3,idb4
C-----------------------------------------------
      DATA memx/0/
CCctmp
CC      data idb1/-1/
CC      data idb2/-1/
CC      data idb3/-1/
CC      data idb4/-1/
C-----------------------------------------------
C   ROLE DE LA ROUTINE:
C   ===================
C   CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
C   > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
C   DANS bpe,hpe, et bpn,hpn
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C
C     NOM          DESCRIPTION                       E/S
C
C     BPE          TABLEAU DES FACETTES A TRIER      E/S
C                  ET DU RESULTAT COTE MAX            
C     PE           TABLEAU DES FACETTES              S
C                  RESULTAT COTE MIN
C     BPN          TABLEAU DES NOEUDS A TRIER        E/S
C                  ET DU RESULTAT COTE MAX            
C     PN           TABLEAU DES NOEUDS                S
C                  RESULTAT COTE MIN
C     ADD(2,*)     TABLEAU DES ADRESSES              E/S 
C          1.......ADRESSES NOEUDS
C          2.......ADRESSES ELEMENTS
C     ZYZM(6,*)     TABLEAU DES XYZMIN               E/S 
C          1.......XMIN BOITE
C          2.......YMIN BOITE
C          3.......ZMIN BOITE
C          4.......XMAX BOITE
C          5.......YMAX BOITE
C          6.......ZMAX BOITE
C     IRECT(4,*)   TABLEAU DES CONEC FACETTES        E
C     X(3,*)       COORDONNEES NODALES               E
C     NB_SC        NOMBRE DE NOEUDS CANDIDATS        E/S
C     NB_MC        NOMBRE D'ELTS CANDIDATS           E/S
C     I_ADD        POSITION DANS LE TAB DES ADRESSES E/S
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_S       boites resultats noeuds
C     CAND_M       adresses des boites resultat elements
C     NSN          4*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
C                  COUPLES NOEUDS,ELT CANDIDATS
C     NOINT        NUMERO USER DE L'INTERFACE
C     TZINF        TAILLE ZONE INFLUENCE
C     MAXBOX       TAILLE MAX BUCKET
C     MINBOX       TAILLE MIN BUCKET
C=======================================================================
C
C
C    1- TEST ARRET = BOITE VIDE
C                    BOITE TROP PETITE 
C                    BOITE NE CONTENANT QU'ONE NOEUD
C                    PLUS DE MEMOIRE DISPONIBLE
C
C-----------------------------------------------------------
C
C      IF(MEMX>ADD(2,1)+NB_MC)THEN
C        WRITE(ISTDO,*)' *******MEM MAX=',MEMX
C        MEMX=-1
C      ELSEIF(MEMX/=-1)THEN
C        MEMX=ADD(2,1)+NB_MC
C      ENDIF
C--------------------TEST SUR BOITE VIDES-------------- 
C
      IF(nb_mc==0.OR.nb_sc==0) THEN
C       write(6,*)" BOITE VIDE"
C       IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
C       AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
C  006        CALL I7DSTK(I_ADD,NB_SC,NB_MC,ADD,BPN,PN,BPE,PE)
        CALL i7dstk(i_add,nb_sc,nb_mc,add(1,i_add-1),bpn,pn,bpe,pe)
        RETURN
      ENDIF
C
C-------------------TEST SUR FIN DE BRANCHE / MEMOIRE DEPASSEE------------
C
      dx = xyzm(4,i_add) - xyzm(1,i_add)
      dy = xyzm(5,i_add) - xyzm(2,i_add)
      dz = xyzm(6,i_add) - xyzm(3,i_add)
      dsup= max(dx,dy,dz)
C
C  006      IF(ADD(1,I_ADD)+NB_SC>=MAXSIZ.OR.ADD(2,1)+NB_MC>=MAXSIZ) THEN
      IF(add(1,i_add)+nb_sc>=maxsiz.OR.
     .   add(2,i_add)+nb_mc>=maxsiz) THEN
C       PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
        IF ( nb_n_b == maxsiz/3) THEN
C          WRITE(IOUT,*)'***ERROR INFINITE LOOP DETECTED '
C          WRITE(ISTDO,*)'***ERROR INFINITE LOOP DETECTED '
C          CALL ARRET(2)
          CALL ancmsg(msgid=685,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=id,
     .                c1=titr)
        ENDIF
        i_mem = 1
        RETURN
      ENDIF
      ncand_prov=nb_mc*nb_sc
      IF(dsup<minbox.OR.istop==1.OR.
     .   (nb_sc<=nb_n_b.AND.dsup<maxbox).OR.   
     .   (nb_sc<=nb_n_b.AND.nb_mc==1).OR.
     .   (nb_mc<=nb_n_b.AND.dsup<maxbox).OR.   
     .   (nb_mc<=nb_n_b.AND.nb_sc==1)) THEN
          istop = 0
C
C       write(6,*)" NOUVELLE BOITE "
C       1- STOCKAGE DU OU DES  NOEUD CANDIDAT ET DES ELTS CORRESP.
C       VIRER LES INUTILES
          DO k=1,ncand_prov,nvsiz
            DO l=k,min(k-1+nvsiz,ncand_prov)
              i = 1+(l-1)/nb_sc
              j = l-(i-1)*nb_sc
              ne = bpe(i)
              nn = bpn(j)
CCctmp
CC       if(idb1==nn.and.idb2==ne)then
CC          idb3=-1
CC       endif
              n1=irectm(1,ne)
              n2=irectm(2,ne)
              nn1=irects(1,nn)
              nn2=irects(2,nn)
              IF(nn1/=n1.AND.nn1/=n2.AND.
     .           nn2/=n1.AND.nn2/=n2) THEN
                j_stok = j_stok + 1
                prov_s(j_stok) = nn
                prov_m(j_stok) = ne
              ENDIF
            ENDDO
            IF(j_stok>=nvsiz)THEN
              CALL i11sto(
     1              nvsiz,irects,irectm,x     ,ii_stok,
     2              cand_s,cand_m,nsn   ,noint ,tzinf ,
     3              i_mem ,prov_s,prov_m,multimp,addcm,
     4              chaine,iadfin)
              IF(i_mem==2)RETURN
              j_stok = j_stok-nvsiz
              DO j=1,j_stok
                prov_s(j) = prov_s(j+nvsiz)
                prov_m(j) = prov_m(j+nvsiz)
              ENDDO
            ENDIF
          ENDDO 
C       IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
C       AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
C  006        CALL I7DSTK(I_ADD,NB_SC,NB_MC,ADD,BPN,PN,BPE,PE)
        CALL i7dstk(i_add,nb_sc,nb_mc,add(1,i_add-1),bpn,
     .              pn,bpe,pe)
        RETURN
      ENDIF
C
C-----------------------------------------------------------
C
C
C    2- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
C                    
C                   
C-----------------------------------------------------------
C
C
C    1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
C
      dir = 1
      IF(dy==dsup) THEN
        dir = 2
      ELSE IF(dz==dsup) THEN
        dir = 3
      ENDIF
      seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))/2
C
C    2- DIVISER LES SECONDS EN TWO ZONES 
C
CC      idb3=-1
      nb_scn= 0
      nb_scn1= 0
C  006      ADDNN= ADD(1,1)
      addnn= add(1,i_add)
      inf = 0
      sup = 0
      DO 70 i=1,nb_sc
        nn = bpn(i)
CC        if(nn==idb1)then
CC          idb3=0
CC        endif
        xx1=x(dir, irects(1,nn))
        xx2=x(dir, irects(2,nn))
        xmax=max(xx1,xx2)+tzinf
        xmin=min(xx1,xx2)-tzinf
        IF(xmin<seuil) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          nb_scn1 = nb_scn1 + 1
          addnn = addnn + 1
          pn(addnn) = bpn(i)
          inf = 1
CC        if(BPN(I)==idb1)then
CC          idb4=-1
CC        endif
        ENDIF
        IF(xmax>=seuil) THEN
          nb_scn = nb_scn + 1
          bpn(nb_scn) = bpn(i)
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
          sup = 1
CC        if(BPN(I)==idb1)then
CC          idb4=-1
CC        endif
        ENDIF
   70 CONTINUE
CC
CC    3- DIVISER LES ELEMENTS 
CC
      nb_mcn= 0
      nb_mcn1= 0
C  006      ADDNE= ADD(2,1)
      addne= add(2,i_add)
      DO i=1,nb_mc
        nn = bpe(i)
        xx1=x(dir, irectm(1,nn))
        xx2=x(dir, irectm(2,nn))
        xmax=max(xx1,xx2)+tzinf
        xmin=min(xx1,xx2)-tzinf
CC        if(nn==idb2)then
CC          if(idb3==0)then
CC            idb4=-1
CC          endif
CC        endif
        IF(xmin<seuil.AND.inf==1) THEN
C         ON STOCKE DANS LE BAS DE LA PILE BP
          nb_mcn1 = nb_mcn1 + 1
          addne = addne + 1
          pe(addne) = bpe(i)
CC        if(nn==idb2)then
CC          if(idb3==0)then
CC            idb4=-1
CC          endif
CC        endif
        ENDIF
        IF(xmax>=seuil.AND.sup==1) THEN
C         ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
          nb_mcn = nb_mcn + 1
          bpe(nb_mcn) = bpe(i)
CC        if(nn==idb2)then
CC          if(idb3==0)then
CC            idb4=-1
CC          endif
CC        endif
        ENDIF
      ENDDO
C
C    4- REMPLIR LES TABLEAUX D'ADRESSES
C
C  006      ADD(1,2) = ADDNN
C  006      ADD(2,2) = ADDNE
      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. seuil est un max pour la courante)
C     on va redescendre et donc on definit une nouvelle boite
C     on remplit les max de la nouvelle boite
C     initialises dans i7buc1 a 1.E30 comme ca on recupere
C     soit XMAX soit le max de la boite
      xyzm(1,i_add+1) = xyzm(1,i_add) 
      xyzm(2,i_add+1) = xyzm(2,i_add)
      xyzm(3,i_add+1) = xyzm(3,i_add)
      xyzm(4,i_add+1) = xyzm(4,i_add)
      xyzm(5,i_add+1) = xyzm(5,i_add)
      xyzm(6,i_add+1) = xyzm(6,i_add)
      xyzm(dir,i_add+1) = seuil
      xyzm(dir+3,i_add) = seuil
C
      IF( ((nb_scn==nb_sc .AND. nb_mcn1==nb_mc) .OR.
     .    (nb_scn1==nb_sc .AND. nb_mcn==nb_mc)) .AND.
     .   min(nb_scn,nb_scn1)>0.AND.
     .   min(nb_mcn,nb_mcn1)>0) istop = istop + 1
C
      nb_sc = nb_scn
      nb_mc = nb_mcn
C     on incremente le niveau de descente avant de sortir
      i_add = i_add + 1
      IF(i_add>=1000) THEN
C       TROP NIVEAUX PILE ON VAS LES PRENDRE PLUS GRANDES...
        IF ( nb_n_b == maxsiz/3) THEN
C          WRITE(IOUT,*)'***COMPUTATION STOPPED WHILE INFINITELY LOOPING'
C          WRITE(ISTDO,*)'***COMPUTATION STOPPED WHILE INFINITELY LOOPING'
C          CALL ARRET(2)
          CALL ancmsg(msgid=83,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=id,
     .                c1=titr)
        ENDIF
        i_mem = 1
        RETURN
      ENDIF
C
C     ce return n'est atteint que dans le cas ok = 0
      RETURN
      END