Esope source files

   1 : C SMAOCR    SOURCE    CHAT      06/03/29    21:34:21     5360           
   2 : C      
   3 :       
   4 :       
   5 : C     *****************************************************************
   6 : C     MODULE  : ST (STRUCTURE DES DONNEES)
   7 : C     FICHIER : ST_1STRUCT.F
   8 : C     OBJET   : FONCTIONS PRATIQUES POUR LA CREATION DE MAILLAGES 
   9 : C
  10 : C     FONCT.  : 
  11 : C       SMAOCR  : CREER LA STRUCTURE DE DONNEE MAILLAGE ORIENTEE
  12 : C                   (CAS DE PLUSIEURS COMPOSANTES CONNEXES)
  13 : C       SFRCRE : CREER LE MAILLAGE FRONTIERE D'UN ENSEMBLE DE 
  14 : C                   MAILLES
  15 : C
  16 : C     AUTEUR  : O. STAB
  17 : C     DATE    : 03.95
  18 : C     MODIFICATIONS :
  19 : C      AUTEUR, DATE, OBJET :
  20 : C
  21 : C
  22 : C     *****************************************************************
  23 : C
  24 : C
  25 :       SUBROUTINE SMAOCR(IDE,ITRI,NBE,COORD,NCOORD,IDIMC,
  26 :      >                   ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,NOEMAX,
  27 :      >                   ITVL,NBTRAV,NCC,iarr)
  28 : C     *****************************************************************
  29 : C     OBJET : CREER LA STRUCTURE DE DONNEE MAILLAGE ORIENTEE
  30 : C                   (CAS DE PLUSIEURS COMPOSANTES CONNEXES)
  31 : C             ITRI -> ITRNOE, ITRTRI, NOETRI
  32 : C     EN ENTREE:
  33 : C      IDE    :  (1..3) DIMENSION DES ELEMENTS 
  34 : C      NBE    :  NOMBRE D'ELEMENTS DU MAILLAGE
  35 : C      ITRI   :  ITRI(I,J) EST LE NOEUD J DE L'ELEMENT I
  36 : C      NBNMAX :  (2..8) NOMBRE DE NOEUDS MAXIMUM DES ELEMENTS 
  37 : C      NBCMAX :  (2..6) NOMBRE DE COTES MAXIMUM DES ELEMENTS 
  38 : C      NOEMAX:   TAILLE DU TABLEAU NOETRI
  39 : C     EN SORTIE:
  40 : C       ITRNOE: ITRNOE(I,J) EST LE NOEUD J DU TRIANGLE I
  41 : C                PEUT ETRE LE MEME TABLEAU QUE ITRI
  42 : C       ITRTRI: ITRTRI(I,J) EST L'ELEMENT INCIDENT A L'ELEMENT I SUR 
  43 : C                LE COTE J
  44 : C       NOETRI : NOETRI(I) EST UN DES ELEMENTS CONTENANT LE NOEUD I
  45 : C                AU MIN = (NBCMAX+1)*NBE 
  46 : C                AU MAX = MAX((NBCMAX+1)*NBE ,
  47 : C                             (NBR MAX D'ELEMENTS EN 1 NOEUD + 1) *
  48 : C                             (NUMERO MAXI DU NOEUD DANS ITRI))
  49 : C                         => O(N)
  50 : C       iarr   : CODE D'ERREUR 0 => OK
  51 : C                -2 => LE TABLEAU ITVL EST TROP PETIT 
  52 : C                -NB => TABLEAU NOETRI TROP PETIT TAILLE SOUHAITE = NB
  53 : C     CONDITION D'APPLICATION : ARETE, TRIANGLE, QUADRANGLE, TETRA      
  54 : C     *****************************************************************
  55 :       IMPLICIT INTEGER(I-N)
  56 :       INTEGER   IDE,ITRI(*),NBE
  57 :       REAL*8      COORD(*)
  58 :       INTEGER   NCOORD,IDIMC,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  59 :       INTEGER   NOETRI(*), NOEMAX, ITVL(*), NBTRAV
  60 :       INTEGER   NCC,iarr
  61 : C
  62 :       INTEGER  STRNBN, GORIEN
  63 :       EXTERNAL STRNBN, GORIEN
  64 :       INTEGER  ITRAM,ITRAP,N,INDC,I,K,NBTRIP(100),IND,IEC
  65 :       REAL*8     ZERO
  66 : C
  67 :       ZERO = 0.0
  67 :       CALL SMACRE(IDE,ITRI,NBE,NCOORD,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  68 :      >                   NOETRI,NOEMAX,ITVL,NBTRAV,iarr)
  69 : C
  70 :       IF( iarr.LT.0 )GO TO 999
  71 :       ITRAM = NBTRAV - NBE
  71 :       CALL SORIEN(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,
  72 :      >                  ITVL,ITRAM,ITVL(ITRAM),NCC,iarr)
  73 :       IF( iarr.LT.0 )GO TO 999
  74 :       IF( IDE.LT.IDIMC )GO TO 999
  75 : C
  76 : C    --- ORIENTATION GEOMETRIQUE IDENTIQUE POUR CHAQUE CC
  77 : C        N'A DE SENS QUE SI LA DIMENSION DES ELEMENTS EST
  78 : C        IDENTIQUE A LA DIMENSION DE L'ESPACE
  79 : C
  80 :       IF( NCC.EQ.1 )THEN
  81 : C
  82 : C     --- UNE SEULE COMPOSANTE CONNEXE -----------------
  83 : C
  84 :         N = STRNBN(1,ITRNOE,NBNMAX)
  85 :         IF( GORIEN(ITRNOE(1),N,COORD,IDIMC,ZERO).EQ.-1)THEN
  86 :           DO 30 I=1,NBE
  87 :             N = STRNBN(I,ITRNOE,NBNMAX)
  87 :             CALL SINVOR(1,N,IDE,ITRNOE((I-1)*NBNMAX+1),
  88 :      >                            ITRTRI((I-1)*NBCMAX+1))
  89 :    30     CONTINUE
  90 :         ENDIF
  91 :       ELSE
  92 : C
  93 : C     --- PLUSIEURS COMPOSANTES CONNEXES ---------------
  94 : C
  95 :         ITRAP = NBTRAV - NBE
  96 :         ITRAM = ITRAP - NBE
  97 :         IND = 1
  98 : C
  99 : C       BUG3 O.STAB 03.08.95 NOMBRE DE PARAMETRES INCORRECT
 100 : C
 100 :         CALL TMAPAR(IDE,ITRTRI,NBCMAX,IND,NBE,
 101 :      >                ITVL,ITVL(ITRAM),ITRAM,
 102 :      >                ITVL(ITRAP),NBTRIP,NCC,100,iarr) 
 103 :         INDC = 1
 104 :         DO 50 I=1,NCC        
 105 :           N = STRNBN(ITVL(ITRAP+INDC),ITRNOE,NBNMAX)
 106 :           IF( GORIEN(ITRNOE(INDC),N,COORD,IDIMC,ZERO).EQ.-1)THEN
 107 :             DO 40 K=0,(NBTRIP(I)-1)
 108 :               IEC = ITVL(ITRAP+INDC+K)
 109 :               N = STRNBN(IEC,ITRNOE,NBNMAX)
 110 : C
 111 : C       BUG4 O.STAB 15.09.95 : NUMERO RELATIF DU COTE (SINVOR)
 112 : C
 112 : C              CALL SINVOR(ITVL(ITRAP+INDC+K),N,IDE,ITRNOE,
 113 : C     >             ITRTRI)
 114 : C     REMPLACER PAR :
 115 : C
 115 :               CALL SINVOR(1,N,IDE,ITRNOE((IEC-1)*NBNMAX+1),
 116 :      >             ITRTRI((IEC-1)*NBCMAX+1))
 117 :    40       CONTINUE
 118 :           ENDIF
 119 :    50   CONTINUE
 120 :       ENDIF
 121 :   999 END     
 122 :  
 123 :  
 124 :