Télécharger hexos.eso

Retour à la liste

hexos
C HEXOS     SOURCE    PV        22/04/26    21:15:04     11344          
      SUBROUTINE HEXOS(ITR1,NBE1,NBN1,ITR2,NBE2,NBN2,COORD,NBCOOR,
     >                 N1,N2,DEN1,DEN2,NBCOUC,
     >                 ITVL,NITMAX,NOSUPR,
     >                 ITR3,NBE3,NBEMAX,NBPMAX,NBNL,ICOIN,ITRACE,
     >                 IERCOD,iarr,RAISON)
C     **********************************************************************
C     OBJET HEXOS : MAILLAGE H8 RACCORDANT 2 MAILLAGE GRILLES COMPATIBLES
C
C     EN ENTREE   :
C
C       --------- MAILLAGES A RACCORDER --------------------------
C       ITR1    : DEFINITION DE LA CONNECTIQUE DU MAILLAGE
C                 ITR1((I-1)*4+J = JIEME NOEUD DU IIEME ELEMENT
C                 LES ELEMENTS SONT DES QUADRANGLES A 4 NOEUDS
C       NBE1    : NOMBRE DE QUADRANGLES DANS LE MAILLAGE ITR1
C       NBN1    : NOMBRE DE NOEUDS DU MAILLAGE ITR1
C
C       ITR2,NBE2,NBN2 : DEFINITION DU DEUXIEME MAILLAGE
C
C       COORD   : TABLEAU DES COORDONNEES DES POINTS
C                 COORD((I-1)*3+J) = LA JIEME COORDONNE DU IEME NOEUD
C       NBCOOR  : NOMBRE DE POINTS DANS LE TABLEAU COORD
C
C       --------- PARAMETRES POUR LE RACCORD -----------------------
C       N1      : NUMERO DU NOEUD DE ITR1 A CONNECTER A N2 DE ITR2
C       N2      : "   "   "   "   "  ITR2 "   "    "  A N1 DE ITR1
C       DEN1    : TAILLE SOUHAITEE POUR LES ELEMENTS S'APPUYANT SUR ITR1
C       DEN2    : "   "   "   "   "    "   "   "    "   "    "  SUR ITR2
C       NBCOUC  : NOMBRE DE COUCHES SUPPLEMENTAIRES(PAR DEFAUT 1 SEULE COUCHE)
C
C       --------- LES TABLEAUX VIDES  ------------------------------
C       ITVL    : TABLEAU D'ENTIERS POUR LES CALCULS
C       NITMAX  : TAILLE DE ITVL, LA PLACE DEMANDEE EST DE :
C           T1 =(NBE2+NBE1)*4 +NBCOOR POUR LA STRUCTURE MAILLAGE (T2=3*NBCOOR)
C           T3 = NBN1 + NBN2  POUR LES GRILLES           (T4 = MAX(NBN1,NBN2))
C           T5 = 2*NBLIG1*NBCOL2 POUR LA GRILLE INTERMEDIAIRE (2 COUCHES)
C           T5 = 0 SI UNE COUCHE
C           T6 = 2*NBLIG1*NBCOL2*(NBRAN-1) + NBCOOR
C           NITMAX >= T1+T3+ MAX(T2,T4,T5+T6)
C                 AVEC NBRAN = (3+NBCOUC+NBCOL2+NBLIG2-NBCOL1-NBLIG1)
C                 AVEC NBN1 = NBNL(1)*NBNL(2) ; NBN1 <= 3 + 2*NBE1
C                      NBN2 = NBNL(3)*NBNL(4) ; NBN2 <= 3 + 2*NBE2
C                 AVEC NBLIG1 = MAX(NBNL(2),NBNL(4))
C                      NBCOL2 = MAX(NBNL(1),NBNL(3))
C
C       ITR3   : TABLEAU DES HEXAEDRES (A REMPLIR)
C       NBEMAX : NOMBRE MAXIMUM D'ELEMENTS (LIE A LA TAILLE DE ITR3)
C                = 0 SI L'ON SOUHAITE SEULEMENT UNE IDENTIFICATION DES
C                GRILLE : NBNL, ICOIN
C       NBPMAX : NOMBRE MAXIMUM DE NOEUDS (LIE A LA TAILLE DE COORD)
C
C       NOSUPR : NOSUPR = 1 SUPPRESSION DES NOEUDS ISOLES
C                NOSUPR = 0 PAS DE SUPPRESSION DE NOEUD
C                (LA SUPPRESSION DES NOEUDS POSE UN PROBLEME
C                 QUAND IL Y A DES NOEUDS MILIEU)
C
C     EN SORTIE   :
C
C       ITR3   : DEFINITION DE LA CONNECTIQUE DU MAILLAGE
C                 ITR3((I-1)*8+J = JIEME NOEUD DU IIEME ELEMENT
C                 LES ELEMENTS SONT DES HEXAEDRES A 8 NOEUDS
C       NBE3   : NOMBRE D'HEXAEDRES DANS LE MAILLAGE ITR3
C       COORD  : TABLEAU DES POINTS CONTENANT LES POINTS AJOUTES
C       NBCOOR : NOMBRE DE POINTS APRES AJOUT
C
C       NBNL   : NOMBRE DE LIGNES ET DE COLONNES DES MAILLAGES ITR1 ET ITR2
C                NBNL(1) = NOMBRE DE COLONNES DE ITR1
C                NBNL(2) = NOMBRE DE LIGNES DE ITR1
C                NBNL(3) = NOMBRE DE COLONNES DE ITR2
C                NBNL(4) = NOMBRE DE LIGNES DE ITR2
C       ICOIN  : LES NUMEROS DES NOEUDS DES COINS DE ITR1 ET ITR2
C                ICOIN(1) = PREMIER COIN DE ITR1....
C                ICOIN(4) = PREMIER COIN DE ITR2 ....
C       iarr   : TYPE D'ERREUR -1 SI DONNEES INCORRECTES
C                              -2 SI TABLEAUX INSUFFISANTS
C       IERCOD : CODE DETAILLE DE L'ERREUR
C         -100 : ERREUR NON REPERTORIEE
C         -101 : LES NUMEROS DES DEUX NOEUDS SONT INCORRECTS
C         -102 : LES DEUX NOEUDS SONT CONFONDUS
C         -103 : LES DENSITES SONT INCORRECTES
C         -104 : LE NOMBRE DE COUCHES DOIT ETRE POSITIF OU NUL
C         -105 : CONNECTIQUE NON VALIDE POUR LE PREMIER MAILLAGE
C         -106 : CONNECTIQUE NON VALIDE POUR LE DEUXIEME MAILLAGE
C         -107 : LES DEUX MAILLAGES PARTAGENT UN NOEUD
C         -108 : LE NOMBRE TOTAL DE LIGNES OU DE COLONNES EST IMPAIR
C         -109 : LA TAILLE SOUHAITEE EST SUPERIEURE A LA TAILLE DISPONIBLE
C         -110 : LE PREMIER MAILLAGE N'EST PAS UNE GRILLE
C         -111 : ORIENTATION DU PREMIER MAILLAGE IMPOSSIBLE
C                LES NOEUDS ET LE MAILLAGE SONT COPLANAIRES
C         -112 : LE DEUXIEME MAILLAGE N'EST PAS UNE GRILLE
C         -113 : ORIENTATION DU DEUXIEME MAILLAGE IMPOSSIBLE
C                LES NOEUDS ET LE MAILLAGE SONT COPLANAIRES
C     **********************************************************************
      IMPLICIT INTEGER(I-N)
-INC CCREEL
      INTEGER ITR1(*),NBE1,NBN1,ITR2(*),NBE2,NBN2
      REAL*8    COORD(*),DEN1,DEN2
      INTEGER NBCOOR,N1,N2,NBCOUC,ITVL(*),NITMAX,NOSUPR
      INTEGER ITR3(*),NBE3
      INTEGER NBNL(*),ICOIN(*)
      INTEGER NBEMAX,NBPMAX,ITRACE,IERCOD,iarr
C
      INTEGER NCC1,NCC2,NBNMX1,NBNMX2,NBCMX1,NBCMX2
      INTEGER ITRTR1,ITRTR2,INOET1,INOET2,ITRAV,ITRVMX
      INTEGER IDE,IDIMC
C
      INTEGER IGR1,NGRMX1,IGR2,NGRMX2,NBCOL3,NBLIG3,NBRAN3
      INTEGER ICOMPR,NBENUL,NBISOL,NBN3,I,IOP
      INTEGER NBEGEN,NBPGEN,NBCMAX,NBNMAX,ITRTRI,NOEMAX,NOETRI(1)
      dimension itrtri(1)
C
      REAL*8    DLONG,RAISON,VK(3)
*      SAVE RAISON
C
C      COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS
C      REAL*8  XYZHUG,XYZMIN,XYZEPS
C
      IERCOD = -100
      ICOMPR = 0
      NBE3   = 0
      IF((N1.LE.0).OR.(N2.LE.0).OR.(N1.GT.NBCOOR).OR.
     >   (N2.GT.NBCOOR))THEN
        iarr = -1
        IERCOD = -101
        CALL DSERRE(1,iarr,'HEXOS','IL FAUT DONNER LES COINS')
        GOTO 9999
      ENDIF
C        ---------------------------
C     --- CALCUL DE LA PROGRESSION  ---
C        ---------------------------
C
      IDIMC  = 3
      DLONG  = 0.0
      DO 5 I=1,IDIMC
        DLONG=(COORD((N1-1)*IDIMC+I)-COORD((N2-1)*IDIMC+I))**2 +DLONG
   5  CONTINUE
      IF( DLONG.GT.XPETIT )DLONG = SQRT(DLONG)
      IF( DLONG.LE.XPETIT )THEN
        iarr = -1
        IERCOD = -102
        CALL DSERRE(1,iarr,'HEXOS',' COINS CONFONDUS')
        GOTO 9999
      ENDIF
      IF((DEN1.LT.0.0 ).OR.(DEN2.LT.0.0))THEN
        iarr = -1
        IERCOD = -103
        CALL DSERRE(1,iarr,'ESHEXO',
     >   ' LA DENSITE DOIT ETRE POSITIVE OU NULLE')
        GOTO 9999
      ENDIF
C      IF((DEN1.GT.(DLONG+XPETIT) ).OR.(DEN2.GT.(DLONG+XPETIT)))THEN
C        iarr = -1
C        IERCOD = -109
C        CALL DSERRE(1,iarr,'ESHEXO',
C     >   ' LA TAILLE SOUHAITEE EST SUPERIEURE A LA TAILLE DISPONIBLE')
C        GOTO 9999
C      ENDIF
C      IF(NBCOUC.LT.0)THEN
C        iarr = -1
C        IERCOD = -104
C        CALL DSERRE(1,iarr,'ESHEXO',
C     >   ' LE NOMBRE DE COUCHES DOIT ETRE POSITIF OU NUL')
C        GOTO 9999
C      ENDIF
C
      IF(NBEMAX.EQ.0)CALL SUGEGE(DEN1,DEN2,DLONG,RAISON,NBCOUC,iarr)
C
      IF( iarr.NE.0 )THEN
        iarr = -1
        IERCOD = -103
        CALL DSERRE(1,iarr,'HEXOS',' APPEL SUGEGE')
        GOTO 9999
      ENDIF
C
C        -------------------------
C     --- CALCUL DE LA STRUCTURE  ---
C        -------------------------
C
      IDE  = 2
      NCC1 = 1
      NCC2 = 1
      NBNMX1 = 4
      NBNMX2 = 4
      NBCMX1 = 4
      NBCMX2 = 4
C
      IF(NITMAX.LT.(((NBE1+NBE2)+ NBCOOR)*4))THEN
        iarr = -2
        CALL DSERRE(1,iarr,'HEXOS',' CREATION DES MAILLAGES')
        GOTO 9999
      ENDIF
C
      ITRTR1 = 1
      INOET1  = (NBCMX1 * NBE1) + ITRTR1
      ITRAV  =     NBCOOR       + INOET1
      ITRVMX = NITMAX - ITRAV
      CALL SMAOCR(IDE,ITR1,NBE1,COORD,
     >            NBCOOR,IDIMC,
     >            ITR1,NBNMX1,ITVL(ITRTR1),
     >            NBCMX1,ITVL(INOET1),NBCOOR,
     >            ITVL(ITRAV),ITRVMX,NCC1,iarr)
      IF(iarr.NE.0)THEN
        IERCOD = -105
        CALL DSERRE(1,iarr,'HEXOS',' APPEL SMAOCR')
        GOTO 9999
      ENDIF
C
C        -------------------------
C
      ITRTR2 = ITRAV
      INOET2 = (NBE2 * NBCMX2) + ITRTR2
      ITRAV  =    NBCOOR       + INOET2
      ITRVMX = NITMAX - ITRAV
      CALL SMAOCR(IDE,ITR2,NBE2,COORD,
     >            NBCOOR,IDIMC,
     >            ITR2,NBNMX2,ITVL(ITRTR2),
     >            NBCMX2,ITVL(INOET2),NBCOOR,
     >            ITVL(ITRAV),ITRVMX,NCC2,iarr)
      IF(iarr.NE.0)THEN
        IERCOD = -106
        CALL DSERRE(1,iarr,'HEXOS',' APPEL SMAOCR')
        GOTO 9999
      ENDIF
C     ----------- FUSION DE INOETRI ------
C      CALL ESEINT(1,' ITR1  ',ITR1,NBE1*4)
C      CALL ESEINT(1,' ITR2  ',ITR2,NBE2*4)
C      CALL ESEINT(1,'INOET1 ',ITVL(INOET1),NBCOOR)
C      CALL ESEINT(1,'INOET2 ',ITVL(INOET2),NBCOOR)
      DO 10 I=1,NBCOOR
        IF(ITVL(I-1+INOET1).EQ.0)THEN
          ITVL(I-1+INOET1) = ITVL(I-1+INOET2) + NBE1
        ELSE
          IF( ITVL(I-1+INOET2).NE.0 )THEN
            iarr = -1
            IERCOD = -107
            CALL DSERRE(1,iarr,'HEXOS',
     >           ' LES 2 MAILLAGES PARTANGENT 1 NOEUD')
            CALL ESEINT(1,'LE NOEUD ',I,1)
            GOTO 9999
          ENDIF
        ENDIF
   10 CONTINUE
C
C         ===========================================
C     ---- 2. CONSTRUCTION DES 2 GRILLES SURFACIQUES ----
C         ===========================================
      IF(ITRACE.GT.0)
     >  CALL ESECHA(1,'-> CONTRUCTION DES 2 GRILLES',' ')
C
      IGR1   = ITRAV
      NGRMX1 = NBN1
      IGR2   = IGR1 + NGRMX1
      NGRMX2 = NBN2
      ITRAV  = IGR2 + NGRMX2
      ITRVMX = NITMAX - ITRAV
      IF( ITRVMX.LT. 0)THEN
        iarr = -2
        CALL DSERRE(1,iarr,'HEXOS',' CREATION DES GRILLES')
        GOTO 9999
      ENDIF
      DO 20 I=1,4
        NBNL(I)    = 0
        ICOIN(I)   = 0
        ICOIN(I+4) = 0
   20 CONTINUE
      CALL Q4ORG2(ITR1,NBNMX1,ITVL(ITRTR1),NBCMX1,NBE1,
     >            ITR2,NBNMX2,ITVL(ITRTR2),NBCMX2,NBE2,N1,N2,
     >            COORD,NBCOOR,IDIMC,
     >            ITVL(ITRAV),ITRVMX,
     >            ITVL(IGR1),NGRMX1,ITVL(IGR2),NGRMX2,
     >            ICOIN,NBNL,0,iarr)
C
C
C
      IF(iarr.EQ.-1)THEN
C
C      ----- PREMIER MAILLAGE ----
C
        IF((NBNL(1).EQ.0).OR.(NBNL(2).EQ.0))THEN
          IERCOD = -110
          CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
          CALL DSERRE(1,iarr,'HEXOS',
     >                ' LE PREMIER MAILLAGE N EST PAS UNE GRILLE')
          GOTO 9999
        ENDIF
        IF((ICOIN(1).NE.N1).AND.(ICOIN(2).NE.N1).AND.
     >     (ICOIN(3).NE.N1).AND.(ICOIN(4).NE.N1))THEN
          IERCOD = -118
          CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
          CALL DSERRE(1,iarr,'HEXOS',
     >     ' LE PREMIER NOEUD N EST PAS DANS LE PREMIER MAILLAGE')
          GOTO 9999
        ENDIF
C      ----- ORIENTATION DE IGR1 ----
C
      DO 25 I=1,IDIMC
        VK(I)=(COORD((N2-1)*IDIMC+I)-COORD((N1-1)*IDIMC+I))
   25 CONTINUE
      CALL G2ORIE(ITVL(IGR1),NBNL(1),NBNL(2),IDIMC,COORD,VK,IOP )
      IF( IOP.EQ. 0)THEN
        IERCOD = -111
        CALL DSERRE(1,iarr,'HEXOS',
     >     ' ORIENTATION DE LA PREMIERE GRILLE IMPOSSIBLE')
        GOTO 9999
      ENDIF
C
C      ----- DEUXIEME MAILLAGE ----
C
        IF((NBNL(3).EQ.0).OR.(NBNL(4).EQ.0))THEN
          IERCOD = -112
          CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
          CALL DSERRE(1,iarr,'HEXOS',
     >                ' LE DEUXIEME MAILLAGE N EST PAS UNE GRILLE')
          GOTO 9999
        ENDIF
        IF((ICOIN(5).NE.N2).AND.(ICOIN(6).NE.N2).AND.
     >     (ICOIN(7).NE.N2).AND.(ICOIN(8).NE.N2))THEN
          IERCOD = -122
          CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
          CALL DSERRE(1,iarr,'HEXOS',
     >   ' LE DEUXIEME NOEUD N EST PAS DANS LE DEUXIEME MAILLAGE')
          GOTO 9999
        ENDIF
C
      CALL G2ORIE(ITVL(IGR2),NBNL(3),NBNL(4),IDIMC,COORD,VK,IOP )
      IF( IOP.EQ. 0)THEN
        IERCOD = -113
        CALL DSERRE(1,iarr,'HEXOS',
     >     ' ORIENTATION DE LA DEUXIEME GRILLE IMPOSSIBLE')
        GOTO 9999
      ENDIF
C
        IF((NBNL(1).GT.NBNL(3)).AND.(NBNL(2).GT.NBNL(4)))THEN
C
C       --- ON INVERSE IGR1 ET IGR2 ---
C
          CALL ESECHA(1,'->  ON INVERSE L ORDRE DES GRILLES ',' ')
          iarr   = 0
          NGRMX1 = NBN2
          IGR2   = IGR1 + NGRMX1
          NGRMX2 = NBN1
          ITRAV  = IGR2 + NGRMX2
          CALL Q4ORG2(ITR2,NBNMX2,ITVL(ITRTR2),NBCMX2,NBE2,
     >            ITR1,NBNMX1,ITVL(ITRTR1),NBCMX1,NBE1,N2,N1,
     >            COORD,NBCOOR,IDIMC,
     >            ITVL(ITRAV),ITRVMX,
     >            ITVL(IGR1),NGRMX1,ITVL(IGR2),NGRMX2,
     >            ICOIN,NBNL,0,iarr)
        ENDIF
C
      ENDIF
C
      IF(ITRACE.GT.0)THEN
        CALL ESECHA(1,'->  GRILLE 1 ',' ')
        CALL ESEINT(1,'COLONNES LIGNES : ',NBNL(1),2)
        CALL ESEINT(1,'LES COINS       : ',ICOIN(1),4)
        CALL ESECHA(1,'->  GRILLE 2 ',' ')
        CALL ESEINT(1,'COLONNES LIGNES : ',NBNL(3),2)
        CALL ESEINT(1,'LES COINS       : ',ICOIN(5),4)
      ENDIF
C
      IF(iarr.NE.0)THEN
        CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
        GOTO 9999
      ENDIF
C
      IF( (MOD(NBNL(1)+NBNL(3),2).NE.0).OR.
     >    (MOD(NBNL(2)+NBNL(4),2).NE.0))THEN
       IERCOD = -108
       iarr   = -1
       GOTO 9999
      ENDIF
C
      IF(NBEMAX.EQ.0)THEN
        NBE3 = 0
        GOTO 9999
      ENDIF
C
C         ===========================================
C     ---- 3. MAILLAGE 3D RACCORDANT LES 2 GRILLES   ----
C         ===========================================
      IF(ITRACE.GT.0)
     >  CALL ESECHA(1,'**** RACCORD 3D ****',' ')
C        ==========================================
C     --- RACCORD EN DEUX COUCHES
C        ==========================================
      IF((NBNL(3).GT.NBNL(1)).AND.(NBNL(4).GT.NBNL(2)))THEN
        IF(ITRACE.GT.0)
     >    CALL ESECHA(1,' RACCORD EN 2 COUCHES : ',
     >                ' MAILLAGE SURFACIQUE INTERMEDIAIRE ')
C        -----------------------------------
C     --- EVALUATION DE LA PLACE NECESSAIRE ---
C        -----------------------------------
      NBLIG3 = NBNL(1)
      NBCOL3 = (NBNL(4)-NBNL(2))/2 +2+NBCOUC-1
      NBRAN3 = NBNL(4)
C
      NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1)
      NBPGEN = NBLIG3*NBCOL3*NBRAN3
C
      NBLIG3 = NBNL(3)
      NBCOL3 = (NBNL(3)-NBNL(1))/2 +2+NBCOUC-1
      NBRAN3 = NBNL(4)
C
      NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1) + NBEGEN
      NBPGEN = NBLIG3*NBCOL3*NBRAN3             + NBPGEN
C
C     --- ON PEUT COMPRIMER EN SUPPRIMANT LES 2 MAILLAGES : ITRINO1...
C
C     --- MAILLAGE EN H8 ---
C
      NBNMAX  = 8
C
      CALL H8RCGG(ITVL(IGR1),NBNL(2),NBNL(1),
     >            ITVL(IGR2),NBNL(4),NBNL(3),
     >            COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
     >            ITVL(ITRAV),ITRVMX,
     >            ITR3,NBNMAX,NBE3,NBN3,
     >            NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
      IF(iarr.NE.0)THEN
        CALL DSERRE(1,iarr,'HEXOS',' APPEL H8RCGG')
        GOTO 9999
      ENDIF
C
      ELSE
C        ==========================================
C     --- RACCORD EN UNE COUCHE
C        ==========================================
        IF(ITRACE.GT.0)
     >    CALL ESECHA(1,' RACCORD EN 1 COUCHES : ',
     >                ' MAILLAGE HEXAEDRIQUE ')
C
C        -----------------------------------
C     --- EVALUATION DE LA PLACE NECESSAIRE ---
C        -----------------------------------
      NBLIG3 = NBNL(3)
      NBCOL3 = (NBNL(3)-NBNL(1)+NBNL(2)-NBNL(4))/2 +2+NBCOUC-1
      NBRAN3 = NBNL(2)
C
      NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1)
      NBPGEN = NBLIG3*NBCOL3*NBRAN3
C
C     --- ON PEUT COMPRIMER EN SUPPRIMANT LES 2 MAILLAGES : ITRINO1...
C
C     --- MAILLAGE EN H8 ---
C
      NBNMAX  = 8
C
      CALL H8RCG2(ITVL(IGR1),NBNL(2),NBNL(1),
     >            ITVL(IGR2),NBNL(4),NBNL(3),
     >            COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
     >            ITVL(ITRAV),ITRVMX,
     >            ITR3,NBNMAX,NBE3,NBN3,
     >            NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
      ENDIF
C
      IF(iarr.NE.0)THEN
        CALL DSERRE(1,iarr,'HEXOS',' APPEL H8RCG2')
        GOTO 9999
      ENDIF
C
C        ===================================================
C     --- 3. COMPRESSION DU MAILLAGE  ---
C        ===================================================
C
   30 CONTINUE
C
      IF((NBNL(2).NE.NBNL(4)).OR.(NBNL(1).NE.NBNL(3)).OR.
     >   (NOSUPR.EQ.1) )THEN
C
       IF(ITRACE.GT.0)THEN
        CALL ESECHA(1,'**** POST-TRAITEMENT ****',' ')
        CALL ESECHA(1,'-> COMPRESSION DU MAILLAGE 3D',' ')
       ENDIF
C
C      --- LA SUPPRESSION DES NOEUDS POSE UN PROBLEME
C          QUAND IL Y A DES NOEUDS MILIEU : IDIMC6 = 0
C
       IDIMC6 = 0
C
       IDE = 3
       NBCMAX = 0
       ITRTRI(1) = 0
       NOEMAX = 0
       NOETRI(1) = 0
       NBENUL = NBE3
       NBISOL = NBCOOR
       CALL NUGCNU(IDE,ITR3,NBNMAX,ITRTRI,NBCMAX,
     >            NOETRI,NOEMAX,NBE3,COORD,IDIMC6,NBCOOR,
     >            ITVL(ITRAV),ITRVMX,iarr)
C
      IF(ITRACE.GT.0)THEN
        CALL ESEINT(1,'NOMBRE D ELEMENTS SUPPRIMES : ',NBENUL-NBE3,1)
        CALL ESEINT(1,'NOMBRE DE  POINTS SUPPRIMES : ',NBISOL-NBCOOR,1)
      ENDIF
      ENDIF
C
C      CALL ESEINT(1,' ITR3  ',ITR3,NBE3*8)
C
 9999 END
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales