Télécharger la plaquette Cast3M


fr en

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
  46.       DO i=1,nlicit
  47.          if (itent.eq.ltent(i)) then
  49.             goto 666
  50.          endif
  51.       enddo
  52.  666  continue
  53.       if (ident.eq.0) then
  54. *  44 2
  55. *     Type d'element inconnu %m1:4
  56.          MOTERR(1:4)=NOMS(ITENT)
  57.          CALL ERREUR(44)
  58.          RETURN
  59.       endif
  60. *     On extrait les éléments du bord qui ne s'appuient pas 
  61. *     sur NODE
  62. *     +1 car ce seront des éléments volumiques
  63.       NBNN=IPT1.NUM(/1)+1
  64.       NBELEM=IPT1.NUM(/2)
  65.       NBSOUS=0
  66.       NBREF=0
  67.       SEGINI IPT2
  68.       IPT2.ITYPEL=LTSOR(ident)
  69.       NBELE2=0
  70.       DO IBELE1=1,IPT1.NUM(/2)
  71.          LNODE=.FALSE.
  72.          DO IBNN1=1,IPT1.NUM(/1)
  73.             INO=IPT1.NUM(IBNN1,IBELE1)
  74.             IF (INO.EQ.NODE) LNODE=.TRUE.
  75.             IPT2.NUM(IBNN1,NBELE2+1)=INO
  76.          ENDDO
  77.          IPT2.NUM(NBNN,NBELE2+1)=NODE
  78.          IPT2.ICOLOR(NBELE2+1)=IPT1.ICOLOR(IBELE1)
  79.          IF (.NOT.LNODE) NBELE2=NBELE2+1
  80.       ENDDO
  81.       NBELEM=NBELE2
  82.       SEGADJ IPT2
  83.       RETURN
  84. *
  85. * End of subroutine ETOIL1
  86. *
  87.       END
  88.  
  89.  
  90.  

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