Télécharger la plaquette Cast3M


fr en

Télécharger eltrno.eso

Retour à la liste

Numérotation des lignes : 

eltrno

  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
  52.       CALL ELARSN(ICODE1,INTSO,INTNO,NBNO1,iarr)
  53.       IF( iarr.NE.0 )THEN
  54.         CALL DSERRE(1,iarr,'ELTRNO ',' APPEL ELARSN')
  55.         GOTO 9999
  56. C      ELSE
  57. C        WRITE(6,*) 'NBNO1 = ',NBNO1
  58. C        WRITE(6,*) 'INTNO = ',INTNO
  59. C        WRITE(6,*) 'NBNMX1 = ',NBNMX1
  60.       ENDIF
  61. C     ---- IL FAUT TROUVER LE NOMBRE
  62. C          D'ARETES DE L'ELEMENT LINEAIRE
  63.       CALL ELTYPE(ITYPE1,IORDR1,IDE1,NBNO1,-1,ICODE1)
  64.       CALL STTYPE(IDE1,NBNE1,NBCE1,-1,ITYPE1,iarr)
  65.       CALL STNBAR(IDE1,NBNE1,NBAR)
  66. C      WRITE(6,*) 'NBAR,NBE1 = ',NBAR,NBE1
  67. C
  68.       DO 200 IEL1=1,NBE1
  69.       DO 100 INDAR=1,NBAR
  70. C
  71. C         =================================
  72. C     ---- EXTRACTION DES ARETES DE ITRNO1----
  73. C         =================================
  74. C
  75. C       ---- INDICES RELATIFS ----
  76. C
  77.         INDSO(1) = INTSO((INDAR-1)*2+1)
  78.         INDSO(2) = INTSO((INDAR-1)*2+2)
  79.         NBNO1 = INTNO(INDAR+1)-INTNO(INDAR)
  80. C        WRITE(6,*) 'NBNO1 = ',NBNO1
  81.         DO 5 I=1,NBNO1
  82.           INDNO(I) = INTNO(INTNO(INDAR-1+I))
  83.     5   CONTINUE
  84. C
  85. C        WRITE(6,*) INDAR,' ARETE DE (S1,S2,N)',
  86. C     >             INDSO(1),INDSO(2),INDNO(1)
  87. C
  88. C       ---- NUMERO ABSOLUS DANS ITRNO1 ------
  89. C      WRITE(6,*) 'NBNMX1 = ',NBNMX1
  90.         NUMSO(1) = ITRNO1((IEL1-1)*NBNMX1+INDSO(1))
  91.         NUMSO(2) = ITRNO1((IEL1-1)*NBNMX1+INDSO(2))
  92. C      WRITE(6,*) 'NUMSO = ',NUMSO
  93.         DO 10 INO=1,NBNO1
  94.           NUMNO(INO) = ITRNO1((IEL1-1)*NBNMX1+INDNO(INO))
  95.    10   CONTINUE
  96. C
  97. C         ==================================
  98. C     ---- AFFECTATION DES ARETES DANS ITRNOE ----
  99. C         ==================================
  100.  
  101.       IEL2 = NOETRI(NUMSO(1))
  102.       IF( IEL2.EQ. 0 )THEN
  103. C       PRINT *,'ERREUR NOEUD ISOLE'
  104.        iarr = -1
  105.        CALL DSERRE(1,iarr,' ELTRNO',' NOEUD ISOLE')
  106.        GOTO 9999
  107.       ENDIF
  108.       NBS = 1
  109. C      WRITE(6,*) 'NBNMAX = ',NBNMAX
  110.       DO 15 J=1,NBNMAX
  111.           IF( ITRNOE((IEL2-1)*NBNMAX+J).EQ.NUMSO(2) )
  112.      >    NBS = NBS+1
  113.    15 CONTINUE
  114. C
  115. C      WRITE(6,*) 'RECHERCHE ARETE ',NUMSO(1),NUMSO(2)
  116. C      WRITE(6,*) 'ON PART DE IEL2, NBS =',IEL2,NBS
  117.       CALL NOAJAR(NUMSO,IEL2,NBS,NUMNO,NBNO1,
  118.      >            ICODE2,IDE2,ITRNO2,NBNMX2,NBE2,
  119.      >            ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  120.      >            ITVL,NITMAX,iarr)
  121.   100 CONTINUE
  122.   200 CONTINUE
  123. C
  124.  9999 END
  125.  
  126.  
  127.  
  128.  

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