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  this routine is called by : I11BUC1(/inter3d1/i11buc1.F)
C----------------------------------------------------------------------------
C  cette routine appelle : I11STO(/inter3d1/i11sto.F)
C                          I7DSTK(/inter3d1/i7dstk.F)
C                          Stop (/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_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,
     .   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,
     .        I,J,K,L
      INTEGER INF,SUP,DIR,N1,N2,NN1,NN2,NN,NE,MEMX,NCAND_PROV
      my_real
     .   dx,dy,dz,dsup,seuil,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 OF THE ROUTINE:
C   ===================
C   CLASSIFIES BPE ELEMENTS AND BPN NODES INTO TWO ZONES
C   > OR < TO A BORDER HERE DETERMINED 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     IRECT(4,*)   ARRAY OF CONEC FACETTES        E
C     X(3,*)       COORDONNEES NODALES               E
C     NB_SC        NUMBER OF CANDIDATE NODES        E/S
C     NB_MC        NUMBER OF CANDIDATE ELEMENTS           E/S
C     I_ADD        POSITION IN THE E/S ADDRESS TAB
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 the couples
C                                CANDIDATES impact    E/S
C     CAND_S       boites resultats nodes C     CAND_M       adresses des boites resultat elements
C     NSN          4*NSN MAX SIZE NOW ALLOWED FOR
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
C
C    1- TEST ARRET = BOITE VIDE
C                    BOITE TROP PETITE 
C                    BOITE NE CONTENANT QU'ONE NODE C                    NOT ENOUGH MEMORY AVAILABLE
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 ON EMPTY BOXES--------------
C
      IF(nb_mc==0.OR.nb_sc==0) THEN
C       write(6,*)" BOITE VIDE"
C       THE BASES OF THE STACKS MUST BE COPIED TO THE CORRESPONDING BAS_DE_PILE
C       BEFORE DESCENDING AGAIN INTO THE INTERMEDIATE BRANCH
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 ON END OF BRANCH / EXCEEDED MEMORY------------
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       NO MORE SPACE IN THE STACK OF BOX ELEMENTS TOO SMALL
        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- STORAGE OF THE CANDIDATE NODE OR NODES AND CORRESPONDING ELEMENTS.
C       REMOVE THE USELESS ONES
          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       THE BASES OF THE STACKS MUST BE COPIED TO THE CORRESPONDING BAS_DE_PILE
C       BEFORE DESCENDING INTO THE ADJACENT BRANCH
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- SORTING PHASE ON THE MEDIAN ACCORDING TO THE LARGEST 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         WE STORE AT THE BOTTOM OF THE BP STACK
          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         WE STORE AT THE BOTTOM OF THE BP STACK
          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-----we fill the mins of the next box and the maxs 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 maxs 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) = 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     we increment the descent level before exiting
      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     this return is only reached in the case ok = 0
      RETURN
      END