Télécharger la plaquette Cast3M


fr en

Télécharger smaocr.eso

Retour à la liste

Numérotation des lignes : 

smaocr

  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
  68.       CALL SMACRE(IDE,ITRI,NBE,NCOORD,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  69.      >                   NOETRI,NOEMAX,ITVL,NBTRAV,iarr)
  70. C
  71.       IF( iarr.LT.0 )GO TO 999
  72.       ITRAM = NBTRAV - NBE
  73.       CALL SORIEN(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,
  74.      >                  ITVL,ITRAM,ITVL(ITRAM),NCC,iarr)
  75.       IF( iarr.LT.0 )GO TO 999
  76.       IF( IDE.LT.IDIMC )GO TO 999
  77. C
  78. C    --- ORIENTATION GEOMETRIQUE IDENTIQUE POUR CHAQUE CC
  79. C        N'A DE SENS QUE SI LA DIMENSION DES ELEMENTS EST
  80. C        IDENTIQUE A LA DIMENSION DE L'ESPACE
  81. C
  82.       IF( NCC.EQ.1 )THEN
  83. C
  84. C     --- UNE SEULE COMPOSANTE CONNEXE -----------------
  85. C
  86.         N = STRNBN(1,ITRNOE,NBNMAX)
  87.         IF( GORIEN(ITRNOE(1),N,COORD,IDIMC,ZERO).EQ.-1)THEN
  88.           DO 30 I=1,NBE
  89.             N = STRNBN(I,ITRNOE,NBNMAX)
  90.             CALL SINVOR(1,N,IDE,ITRNOE((I-1)*NBNMAX+1),
  91.      >                            ITRTRI((I-1)*NBCMAX+1))
  92.    30     CONTINUE
  93.         ENDIF
  94.       ELSE
  95. C
  96. C     --- PLUSIEURS COMPOSANTES CONNEXES ---------------
  97. C
  98.         ITRAP = NBTRAV - NBE
  99.         ITRAM = ITRAP - NBE
  100.         IND = 1
  101. C
  102. C       BUG3 O.STAB 03.08.95 NOMBRE DE PARAMETRES INCORRECT
  103. C
  104.         CALL TMAPAR(IDE,ITRTRI,NBCMAX,IND,NBE,
  105.      >                ITVL,ITVL(ITRAM),ITRAM,
  106.      >                ITVL(ITRAP),NBTRIP,NCC,100,iarr)
  107.         INDC = 1
  108.         DO 50 I=1,NCC
  109.           N = STRNBN(ITVL(ITRAP+INDC),ITRNOE,NBNMAX)
  110.           IF( GORIEN(ITRNOE(INDC),N,COORD,IDIMC,ZERO).EQ.-1)THEN
  111.             DO 40 K=0,(NBTRIP(I)-1)
  112.               IEC = ITVL(ITRAP+INDC+K)
  113.               N = STRNBN(IEC,ITRNOE,NBNMAX)
  114. C
  115. C       BUG4 O.STAB 15.09.95 : NUMERO RELATIF DU COTE (SINVOR)
  116. C
  117. C              CALL SINVOR(ITVL(ITRAP+INDC+K),N,IDE,ITRNOE,
  118. C     >             ITRTRI)
  119. C     REMPLACER PAR :
  120. C
  121.               CALL SINVOR(1,N,IDE,ITRNOE((IEC-1)*NBNMAX+1),
  122.      >             ITRTRI((IEC-1)*NBCMAX+1))
  123.    40       CONTINUE
  124.           ENDIF
  125.    50   CONTINUE
  126.       ENDIF
  127.   999 END
  128.  
  129.  
  130.  
  131.  

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