Télécharger etoil1.eso

Retour à la liste

Numérotation des lignes :

etoil1
  1. C ETOIL1 SOURCE GOUNAND 21/03/31 21:15:05 10931
  2. SUBROUTINE ETOIL1(NODE,IPT1,
  3. $ IPT2)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : ETOIL1
  8. C
  9. C DESCRIPTION : Etant donné un maillage simple IPT1 constitue
  10. C d'elements de type POI1, SEG2, TRI3 ou QUA4 et un noeud NODE, on
  11. C construit IPT2 le maillage obtenu par étoilement de IPT1 avec
  12. C NODE.
  13. C L'étoilement est fait avec les éléments de IPT1 qui ne
  14. C contiennent pas NODE.
  15. C IPT1 est supposé actif. IPT2 est rendu actif*MOD.
  16. C
  17. C
  18. C LANGAGE : ESOPE
  19. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  20. C mél : gounand@semt2.smts.cea.fr
  21. C***********************************************************************
  22. C VERSION : v1, 05/02/2013, version initiale
  23. C HISTORIQUE : v1, 05/05/2013, création
  24. C HISTORIQUE : v2, gestion correcte du ITYPEL
  25. C HISTORIQUE :
  26. C***********************************************************************
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCGEOME
  30. -INC SMELEME
  31. PARAMETER(NLICIT=4)
  32. INTEGER LTENT(NLICIT)
  33. INTEGER LTSOR(NLICIT)
  34. * Type d'éléments en entrée
  35. * POI1 SEG2 TRI3 QUA4
  36. DATA LTENT/ 1, 2, 4, 8/
  37. * Type d'éléments en sortie
  38. * SEG2 TRI3 TET4 PYR5
  39. DATA LTSOR/ 2, 4, 23, 25/
  40. LOGICAL LNODE
  41. *
  42. * Executable statements
  43. *
  44. ITENT=IPT1.ITYPEL
  45. DO i=1,nlicit
  46. if (itent.eq.ltent(i)) then
  47. goto 666
  48. endif
  49. enddo
  50. 666 continue
  51. if (ident.eq.0) then
  52. * 44 2
  53. * Type d'element inconnu %m1:4
  54. MOTERR(1:4)=NOMS(ITENT)
  55. CALL ERREUR(44)
  56. RETURN
  57. endif
  58. * On extrait les éléments du bord qui ne s'appuient pas
  59. * sur NODE
  60. * +1 car ce seront des éléments volumiques
  61. NBNN=IPT1.NUM(/1)+1
  62. NBELEM=IPT1.NUM(/2)
  63. NBSOUS=0
  64. NBREF=0
  65. SEGINI IPT2
  66. IPT2.ITYPEL=LTSOR(ident)
  67. NBELE2=0
  68. DO IBELE1=1,IPT1.NUM(/2)
  69. LNODE=.FALSE.
  70. DO IBNN1=1,IPT1.NUM(/1)
  71. INO=IPT1.NUM(IBNN1,IBELE1)
  72. IF (INO.EQ.NODE) LNODE=.TRUE.
  73. IPT2.NUM(IBNN1,NBELE2+1)=INO
  74. ENDDO
  75. IPT2.NUM(NBNN,NBELE2+1)=NODE
  76. IPT2.ICOLOR(NBELE2+1)=IPT1.ICOLOR(IBELE1)
  77. IF (.NOT.LNODE) NBELE2=NBELE2+1
  78. ENDDO
  79. NBELEM=NBELE2
  80. SEGADJ IPT2
  81. RETURN
  82. *
  83. * End of subroutine ETOIL1
  84. *
  85. END
  86.  
  87.  
  88.  

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