Télécharger la plaquette Cast3M


fr en

Télécharger etoil2.eso

Retour à la liste

Numérotation des lignes : 

etoil2

  1. C ETOIL2    SOURCE    GOUNAND   21/04/06    21:15:09     10940          
  2.       SUBROUTINE ETOIL2(NODE,IPT1,
  3.      $        TRAVL)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM         : ETOIL2
  8. C DESCRIPTION : Etant donné un contour IPT1 et un noeud NODE
  9. C               On construit le maillage obtenu par étoilement 
  10. C     de IPT1 avec NODE et on l'ajoute aux candidats dans TRAVL
  11. C     
  12. C               L'étoilement doit être fait avec les éléments de IPT1
  13. C               qui ne contiennent pas NODE.
  14. C               IPT1 est supposé actif.
  15. C               TRAVL actif en *MOD
  16. C
  17. C               Repris de ETOIL1
  18. C
  19. C LANGAGE     : ESOPE
  20. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  21. C               mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C VERSION    : v1, 30/10/2017, version initiale
  24. C HISTORIQUE : v1, 30/10/2017, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC TMATOP2
  31. -INC SMELEME
  32. -INC TMATOP1
  33. *-INC SMELEMX
  34.       POINTEUR LMCANS.MELEMX
  35. -INC SMLENTI
  36.       POINTEUR LIDXCA.MLENTI
  37. *-INC STRAVL
  38.  
  39.       LOGICAL LNODE,lchang
  40. *     
  41. * Executable statements
  42. *
  43. *     On extrait les éléments du bord qui ne s'appuient pas 
  44. *     sur NODE
  45. * +1 car ce seront des éléments volumiques
  46. *      NBNN=IPT1.NUM(/1)+1
  47. *      NBELEM=IPT1.NUM(/2)
  48. *      NBSOUS=0
  49. *      NBREF=0
  50. *      SEGINI IPT2
  51. *TRI3
  52. *      IF (IDIM.EQ.2) IPT2.ITYPEL=4
  53. *      IF (IDIM.EQ.3) IPT2.ITYPEL=23
  54.  
  55.       NCCOUO=TRAVL.NCCOU
  56.       LMCANS=TRAVL.MCANS
  57.       LIDXCA=TRAVL.IDXCA
  58.       NLCOUO=LMCANS.NLCOU
  59.       NNC=NCCOUO+1
  60.       NNL=NLCOUO+IPT1.NUM(/2)
  61.       CALL TRLADJ(TRAVL,NNC,NNL,lchang,'etoil2 : TRAVL_1')
  62.       if (ierr.ne.0) return
  63.       IDX=LIDXCA.LECT(NNC)
  64. *      NBELE2=0
  65.       DO IBELE1=1,IPT1.NUM(/2)
  66.          LNODE=.FALSE.
  67.          DO IBNN1=1,IPT1.NUM(/1)
  68.             INO=IPT1.NUM(IBNN1,IBELE1)
  69.             IF (INO.EQ.NODE) LNODE=.TRUE.
  70. *            IPT2.NUM(IBNN1,NBELE2+1)=INO
  71.             LMCANS.NUMX(IBNN1,IDX)=INO
  72.          ENDDO
  73. *         IPT2.NUM(NBNN,NBELE2+1)=NODE
  74.          LMCANS.NUMX(IPT1.NUM(/1)+1,IDX)=NODE
  75.          IF (.NOT.LNODE) IDX=IDX+1
  76.       ENDDO
  77.       LIDXCA.LECT(NNC+1)=IDX
  78. *     NBELEM=NBELE2
  79. *     SEGADJ IPT2
  80.       if (iveri.ge.1) then
  81.          do ibele2=lidxca.lect(nnc+1),lidxca.lect(nnc)+IPT1.num(/2)-1
  82.             DO IBNN2=1,IPT1.NUM(/1)+1
  83.                LMCANS.NUMX(IBNN2,ibele2)=0
  84.             ENDDO
  85.          enddo
  86.       endif
  87.       NNL=IDX-1
  88.       CALL TRLADJ(TRAVL,NNC,NNL,lchang,'etoil2 : TRAVL_2')
  89.       if (ierr.ne.0) return
  90.       RETURN
  91. *
  92. * End of subroutine ETOIL2
  93. *
  94.       END
  95.  
  96.  
  97.  

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