Télécharger smaocr.eso

Retour à la liste

Numérotation des lignes :

  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