Télécharger eltrno.eso

Retour à la liste

Numérotation des lignes :

  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