Esope source files

   1 : C ELTRNO    SOURCE    CHAT      06/03/29    21:20:24     5360           
   2 : C 
   3 : C
   4 :       SUBROUTINE ELTRNO(ICODE1,IDE1,ITRNO1,NBNMX1,NBE1,
   5 :      >                  ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,NOEMAX,
   6 :      >                  ITVL,NITMAX,
   7 :      >                  ICODE2,IDE2,ITRNO2,NBNMX2,NBE2,
   8 :      >                  iarr)
   9 : C      *****************************************************************
  10 : C     OBJET ELTRNO : TRANSFERT LES NOEUDS MILIEU D'UN MAILLAGE A UN 
  11 : C     OBJET          AUTRE
  12 : C
  13 : C     EN ENTREE    :
  14 : C       ---------- LE MAILLAGE AVEC NOEUDS A TRANSFERER --------
  15 : C       ICODE1 : CODE DES ELEMENTS DE ITRNO1
  16 : C       ITRNO1 : NOEUDS DES ELEMENTS (AVEC NOEUDS MILIEU)
  17 : C       IFARSN : FONCTION QUI RENVOI LES SOMMETS D'UNE ARETE (ELARSN)
  18 : C       ---------- LE MAILLAGE SANS NOEUDS ---------------------
  19 : C       ITRNOE : IDEM ITRNO2 (SANS NOEUDS MILIEU)
  20 : C       ITRTRI : TABLEAU DES ELEMENTS VOISINS
  21 : C       ITRNOE : ELEMENTS INCIDENT AU NOEUDS
  22 : C       NBNMAX : NOMBRE DE NOEUDS D'UN ELEMENT
  23 : C       NBE    : NOMBRE D'ELEMENTS = NBE2
  24 : C       ----------TABLEAU DE TRAVAIL ---------------------------
  25 : C       ITVL   : TABLEAU D'ENTIERS
  26 : C       NITMAX : TAILLE DE ITVL
  27 : C       ---------- LE MAILLAGE AVEC NOEUDS QUI RECOIT ----------
  28 : C       ICODE2 : CODE DES ELEMENTS DE ITRNO2
  29 : C       IFSNAR : FONCTION QUI RENVOI LES NOEUDS ENTRE 2 SOMMETS (ELSNAR)
  30 : C       IDE2   : DIMENSION DES ELEMENTS
  31 : C       ITRNO2 : NOEUDS DES ELEMENTS (AVEC NOEUDS MILIEU A REMPLIR)
  32 : C       NBNMX2 : NOMBRE DE NOEUDS D'UN ELEMENT
  33 : C       NBE2   : NOMBRE D'ELEMENTS
  34 : C
  35 : C     EN SORTIE    :
  36 : C       ITRNO2 : NOEUDS DES ELEMENTS AVEC NOEUDS MILIEU DE ITRNO1
  37 : C       iarr   : CODE D'ERREUR
  38 : C     *****************************************************************
  39 :       IMPLICIT INTEGER(I-N)
  40 :       INTEGER ICODE1,IDE1,ITRNO1(*),NBNMX1,NBE1
  41 :       INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NOETRI(*),NOEMAX
  42 :       INTEGER ITVL(*),NITMAX
  43 :       INTEGER ICODE2,IDE2,ITRNO2(*),NBNMX2,NBE2,iarr
  44 : C
  45 :       INTEGER IEL1
  46 :       INTEGER NBAR,INDAR,INDSO(2),INDNO(2),NBNO1,NUMSO(2),NUMNO(1),INO
  47 :       INTEGER IEL2,NBS,I,J
  48 :       INTEGER INTSO(24),INTNO(100)
  49 :       INTEGER NBNE1,NBCE1,ITYPE1,IORDR1
  50 : C
  51 : C      WRITE(6,*) 'ICODE = ',ICODE1
  51 :       CALL ELARSN(ICODE1,INTSO,INTNO,NBNO1,iarr)
  52 :       IF( iarr.NE.0 )THEN
  52 :         CALL DSERRE(1,iarr,'ELTRNO ',' APPEL ELARSN')
  53 :         GOTO 9999
  54 : C      ELSE
  55 : C        WRITE(6,*) 'NBNO1 = ',NBNO1
  56 : C        WRITE(6,*) 'INTNO = ',INTNO
  57 : C        WRITE(6,*) 'NBNMX1 = ',NBNMX1
  58 :       ENDIF
  59 : C     ---- IL FAUT TROUVER LE NOMBRE 
  60 : C          D'ARETES DE L'ELEMENT LINEAIRE
  60 :       CALL ELTYPE(ITYPE1,IORDR1,IDE1,NBNO1,-1,ICODE1)
  60 :       CALL STTYPE(IDE1,NBNE1,NBCE1,-1,ITYPE1,iarr)
  60 :       CALL STNBAR(IDE1,NBNE1,NBAR)
  61 : C      WRITE(6,*) 'NBAR,NBE1 = ',NBAR,NBE1
  62 : C
  63 :       DO 200 IEL1=1,NBE1
  64 :       DO 100 INDAR=1,NBAR
  65 : C
  66 : C         =================================
  67 : C     ---- EXTRACTION DES ARETES DE ITRNO1----
  68 : C         =================================
  69 : C
  70 : C       ---- INDICES RELATIFS ----
  71 : C
  72 :         INDSO(1) = INTSO((INDAR-1)*2+1)
  73 :         INDSO(2) = INTSO((INDAR-1)*2+2)
  74 :         NBNO1 = INTNO(INDAR+1)-INTNO(INDAR)
  75 : C        WRITE(6,*) 'NBNO1 = ',NBNO1
  76 :         DO 5 I=1,NBNO1
  77 :           INDNO(I) = INTNO(INTNO(INDAR-1+I))
  78 :     5   CONTINUE
  79 : C
  80 : C        WRITE(6,*) INDAR,' ARETE DE (S1,S2,N)',
  81 : C     >             INDSO(1),INDSO(2),INDNO(1)
  82 : C
  83 : C       ---- NUMERO ABSOLUS DANS ITRNO1 ------
  84 : C      WRITE(6,*) 'NBNMX1 = ',NBNMX1
  85 :         NUMSO(1) = ITRNO1((IEL1-1)*NBNMX1+INDSO(1))
  86 :         NUMSO(2) = ITRNO1((IEL1-1)*NBNMX1+INDSO(2))
  87 : C      WRITE(6,*) 'NUMSO = ',NUMSO
  88 :         DO 10 INO=1,NBNO1
  89 :           NUMNO(INO) = ITRNO1((IEL1-1)*NBNMX1+INDNO(INO))
  90 :    10   CONTINUE
  91 : C
  92 : C         ==================================
  93 : C     ---- AFFECTATION DES ARETES DANS ITRNOE ----
  94 : C         ==================================
  95 : 
  96 :       IEL2 = NOETRI(NUMSO(1))
  97 :       IF( IEL2.EQ. 0 )THEN
  98 : C       PRINT *,'ERREUR NOEUD ISOLE'
  99 :        iarr = -1
  99 :        CALL DSERRE(1,iarr,' ELTRNO',' NOEUD ISOLE')
 100 :        GOTO 9999
 101 :       ENDIF
 102 :       NBS = 1
 103 : C      WRITE(6,*) 'NBNMAX = ',NBNMAX
 104 :       DO 15 J=1,NBNMAX
 105 :           IF( ITRNOE((IEL2-1)*NBNMAX+J).EQ.NUMSO(2) )
 106 :      >    NBS = NBS+1
 107 :    15 CONTINUE 
 108 : C
 109 : C      WRITE(6,*) 'RECHERCHE ARETE ',NUMSO(1),NUMSO(2)
 110 : C      WRITE(6,*) 'ON PART DE IEL2, NBS =',IEL2,NBS
 110 :       CALL NOAJAR(NUMSO,IEL2,NBS,NUMNO,NBNO1,
 111 :      >            ICODE2,IDE2,ITRNO2,NBNMX2,NBE2,
 112 :      >            ITRNOE,NBNMAX,ITRTRI,NBCMAX,
 113 :      >            ITVL,NITMAX,iarr)
 114 :   100 CONTINUE
 115 :   200 CONTINUE
 116 : C
 117 :  9999 END
 118 :  
 119 :  
 120 :