Esope source files

   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 :