Télécharger elcree.eso

Retour à la liste

Numérotation des lignes :

elcree
  1. C ELCREE SOURCE CHAT 06/03/29 21:20:05 5360
  2. C
  3. C *****************************************************************
  4. C MODULE : EL (INTERFACE CODE DE CALCUL)
  5. C FICHIER : NOMILIEU.F
  6. C OBJET : CALCUL ET TRANSFERT DES NOEUDS MILIEU
  7. C FONCT. :
  8. C
  9. C ------ INDICES RELATIFS DES SOMMETS ET NOEUDS DES ELEMENTS ----
  10. C OBJET ELNOSO : NOEUD ET SOMMET D UN ELEMENT
  11. C OBJET ELARSO : LES 2 SOMMETS D'UNE ARETE
  12. C OBJET ELARNO : LE (LES) NOEUDS MILIEU SUR UNE ARETE
  13. C OBJET ELSOAR : L'ARETE ENTRE 2 SOMMETS
  14. C
  15. C ------ TRANSFERT DES NOEUDS MILIEU ----
  16. C OBJET ELTRNO : TRANSFERT LES NOEUDS MILIEU D'UN MAILLAGE A UN
  17. C OBJET AUTRE
  18. C
  19. C AUTEUR : O. STAB
  20. C DATE : 05.11.96
  21. C TESTS : A FAIRE
  22. C
  23. C MODIFICATIONS :
  24. C AUTEUR, DATE, OBJET :
  25. C
  26. C
  27. C *****************************************************************
  28. SUBROUTINE ELCREE(IDE1,ITRNO1,NBNMX1,NBE1,
  29. > ICODE2,ITSOVO,ISENS,IDE2,ITRNO2,NBNMX2,NBE2,
  30. > iarr)
  31. C *****************************************************************
  32. C OBJET ELTRNO : CREE UN MAILLAGE AVEC DES NOEUDS SUPPLEMENTAIRES
  33. C
  34. C EN ENTREE :
  35. C ---------- LE MAILLAGE INITIAL -------------------------
  36. C IDE1 : DIMENSION DES ELEMENTS
  37. C ITRNO1 : NOEUDS DES ELEMENTS
  38. C NBNMX1 : NOMBRE DE NOEUDS D'UN ELEMENT
  39. C NBE1 : NOMBRE D'ELEMENTS
  40. C ---------- LE MAILLAGE AVEC NOEUDS SUPPLEMENTAIRES -----
  41. C ICODE2 : CODE DES ELEMENTS DE ITRNO2
  42. C ITSOVO : POSITIONS DES SOMMETS POUR LE TRANSFERT
  43. C ITRNO1 --> ITRNO2
  44. C ISENS : = 1 ITRNO2 A PLUS DE NOEUDS QUE ITRNO1
  45. C ITRNO1(I) --> ITRNO2(ITSOVO(I))
  46. C = -1 ITRNO2 A MOINS DE NOEUDS QUE ITRNO1
  47. C ITRNO1(ITSOVO(I)) --> ITRNO2(I)
  48. C
  49. C IDE2 : DIMENSION DES ELEMENTS
  50. C ITRNO2 : NOEUDS DES ELEMENTS (AVEC NOEUDS MILIEU A REMPLIR)
  51. C NBNMX2 : NOMBRE DE NOEUDS D'UN ELEMENT
  52. C NBE2 : NOMBRE D'ELEMENTS
  53. C
  54. C EN SORTIE :
  55. C ITRNO2 : NOEUDS DES ELEMENTS (TRANSFERES DE ITRNO1)
  56. C iarr : CODE D'ERREUR
  57. C *****************************************************************
  58. IMPLICIT INTEGER(I-N)
  59. INTEGER IDE1,ITRNO1(*),NBNMX1,NBE1
  60. INTEGER ITSOVO(*)
  61. INTEGER ICODE2,ISENS,IDE2,ITRNO2(*),NBNMX2,NBE2,iarr
  62. C
  63. INTEGER I,J,K
  64. C
  65. IF(NBNMX2.LE.0)THEN
  66. iarr = -2
  67. NBE2 = 0
  68. IDE2 = 0
  69. GOTO 9999
  70. ENDIF
  71. C
  72. NBE2 = NBE1
  73. IDE2 = IDE1
  74. C
  75. C ---- ON AJOUTE DES TROUS (0) DANS ITRNO2 ----
  76. C
  77. IF( ISENS .GE. 0 )THEN
  78. DO 10 I=1,NBE2*NBNMX2
  79. ITRNO2(I) = 0
  80. 10 CONTINUE
  81. DO 200 I=1,NBE1
  82. DO 100 J=1,NBNMX1
  83. K = ITSOVO(J)
  84. IF( K.NE.0 )
  85. > ITRNO2((I-1)*NBNMX2+K)=ITRNO1((I-1)*NBNMX1+J)
  86. 100 CONTINUE
  87. 200 CONTINUE
  88. C
  89. C ---- ON SUPPRIME DES NOEUDS DANS ITRNO2 ----
  90. C
  91. ELSE
  92. DO 400 I=1,NBE2
  93. DO 300 J=1,NBNMX2
  94. K = ITSOVO(J)
  95. IF( K.NE.0 )
  96. > ITRNO2((I-1)*NBNMX2+J)=ITRNO1((I-1)*NBNMX1+K)
  97. 300 CONTINUE
  98. 400 CONTINUE
  99. ENDIF
  100. C
  101. 9999 END
  102.  
  103.  
  104.  
  105.  

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