Télécharger la plaquette Cast3M


fr en

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