Télécharger elccno.eso

Retour à la liste

Numérotation des lignes :

  1. C ELCCNO SOURCE CHAT 06/03/29 21:19:49 5360
  2. C
  3. C
  4. SUBROUTINE ELCCNO(ICODE,IDE,ITRNO2,NBNMX2,NBE,
  5. > ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  6. > ITVL,NITMAX,
  7. > COORD,IDIMC,NBCOOR,NBCOMX,iarr)
  8. C *****************************************************************
  9. C OBJET ELCCNO : CALCUL LES NOEUDS MILIEU (MANQUANT) D'UN MAILLAGE
  10. C
  11. C EN ENTREE :
  12. C ---------- LE MAILLAGE A REMPLIR -----------------------
  13. C ICODE : CODE DES ELEMENTS DE ITRNOE
  14. C ITRNOE : NOEUDS DES ELEMENTS (AVEC NOEUDS MILIEU)
  15. C IFARSN : FONCTION QUI RENVOI LES SOMMETS D'UNE ARETE (ELARSN)
  16. C IFCCPO : FONCTION QUI CALCUL LES POINTS MILIEU
  17. C ---------- LE MAILLAGE SANS NOEUDS ---------------------
  18. C ITRNOE : IDEM ITRNO2 (SANS NOEUDS MILIEU)
  19. C ITRTRI : TABLEAU DES ELEMENTS VOISINS
  20. C NBNMAX : NOMBRE DE NOEUDS D'UN ELEMENT
  21. C NBE : NOMBRE D'ELEMENTS = NBE2
  22. C ----------TABLEAU DE TRAVAIL ---------------------------
  23. C ITVL : TABLEAU D'ENTIERS
  24. C NITMAX : TAILLE DE ITVL
  25. C ----------TABLEAU DE TRAVAIL ---------------------------
  26. C COORD : TABLEAU DES COORDONNEES
  27. C IDIMC : DIMENSION DE L'ESPACE
  28. C NBCOOR : NOMBRE DE POINTS DANS COORD
  29. C
  30. C EN SORTIE :
  31. C ITRNOE : NOEUDS DES ELEMENTS AVEC NOEUDS MILIEU
  32. C iarr : CODE D'ERREUR
  33. C *****************************************************************
  34. IMPLICIT INTEGER(I-N)
  35. INTEGER ICODE,IDE,ITRNO2(*),NBNMX2,NBE
  36. INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  37. INTEGER ITVL(*),NITMAX
  38. REAL*8 COORD(*)
  39. INTEGER IDIMC,NBCOOR,NBCOMX,iarr
  40. C
  41. C
  42. INTEGER IEL,NBAR,INDAR,INDSO(2),INDNO(1),NBNO,NUMSO(2),NUMNO,INO
  43. INTEGER NOETRI,NOEMAX
  44. REAL*8 XYZ(3)
  45. INTEGER INTSO(24),INTNO(100),I,NBSOM,NBNOE
  46. INTEGER NBS
  47. C
  48. CALL ELSOVO(ICODE,INTNO,NBSOM,NBNOE,iarr)
  49. C WRITE(6,*) 'ICODE, NBSOM =',ICODE,NBSOM
  50. IF( iarr.NE.0 )THEN
  51. CALL DSERRE(1,iarr,'ELCCNO ',' APPEL ELSOVO')
  52. GOTO 9999
  53. ENDIF
  54. CALL STNBAR(IDE,NBSOM,NBAR)
  55. C
  56. CALL ELARSN(ICODE,INTSO,INTNO,NBNO,iarr)
  57. IF( iarr.NE.0 )THEN
  58. CALL DSERRE(1,iarr,'ELCCNO ',' APPEL ELARSN')
  59. GOTO 9999
  60. ENDIF
  61. C
  62. C WRITE(6,*) 'IDE,NBNMAX,NBARETE = ',IDE,NBNMAX,NBAR
  63. C
  64. DO 200 IEL=1,NBE
  65. C WRITE(6,*) '==========================================='
  66. C WRITE(6,*) ' ELEMENT ',IEL
  67. C WRITE(6,*) '==========================================='
  68. DO 100 INDAR=1,NBAR
  69. C
  70. C =================================
  71. C ---- EXTRACTION DES ARETES ----
  72. C =================================
  73. C
  74. C ---- INDICES RELATIFS ----
  75. C
  76. INDSO(1) = INTSO((INDAR-1)*2+1)
  77. INDSO(2) = INTSO((INDAR-1)*2+2)
  78. NBNO = INTNO(INDAR+1)-INTNO(INDAR)
  79. DO 5 I=1,NBNO
  80. INDNO(I) = INTNO(INTNO(INDAR-1+I))
  81. 5 CONTINUE
  82. C
  83. C WRITE(6,*) INDAR,' ARETE DE (S1,S2,N)',
  84. C > INDSO(1),INDSO(2),INDNO(1)
  85. C
  86. C ---- NUMERO ABSOLUS DANS ITRNO1 ------
  87. NUMSO(1) = ITRNO2((IEL-1)*NBNMX2+INDSO(1))
  88. NUMSO(2) = ITRNO2((IEL-1)*NBNMX2+INDSO(2))
  89. DO 10 INO=1,NBNO
  90. NUMNO = ITRNO2((IEL-1)*NBNMX2+INDNO(INO))
  91. IF( NUMNO.EQ. 0 )THEN
  92. C ==================================
  93. C ---- CALCUL DES NOEUDS MILIEU ----
  94. C ==================================
  95. CALL ELCCPO(COORD((NUMSO(1)-1)*IDIMC+1),
  96. > COORD((NUMSO(2)-1)*IDIMC+1),IDIMC,
  97. > ICODE,INDAR,INO,NBNO,XYZ,iarr)
  98. NOEMAX = 0
  99. CALL S0AJNO(XYZ,COORD,IDIMC,NBCOOR,NBCOMX,
  100. > NOETRI,NOEMAX,NUMNO,iarr)
  101. C WRITE(6,*) 'NOEUD CREE = ',NUMNO
  102. NBS = 2
  103. CALL NOAJAR(NUMSO,IEL,NBS,NUMNO,NBNO,
  104. > ICODE,IDE,ITRNO2,NBNMX2,NBE,
  105. > ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  106. > ITVL,NITMAX,iarr)
  107. C ELSE
  108. C WRITE(6,*) 'ENTRE ',NUMSO(1),NUMSO(2),
  109. C > 'LE NOEUD EXISTE DEJA ',NUMNO
  110. ENDIF
  111. 10 CONTINUE
  112.  
  113. 100 CONTINUE
  114. 200 CONTINUE
  115. C
  116. 9999 END
  117.  
  118.  
  119.  
  120.  

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