Télécharger la plaquette Cast3M


fr en

Télécharger elenbl.eso

Retour à la liste

Numérotation des lignes : 

elenbl

  1. C ELENBL    SOURCE    CHAT      05/01/12    23:31:01     5004
  2.       SUBROUTINE ELENBL(MCLAS,MCLPO1,MCENT,LEPOEL,
  3.      $     ELNBEL,IMPR,IRET)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM         : ELENBL
  8. C DESCRIPTION : Construit une liste d'entiers : ELNBEL (type MLENTI)
  9. *               NOCENT : indice du centre de l'élément considéré dans MCENT
  10. *               ELNBEL(NOCENT) : nombre d'éléments partageant (au moins)
  11. *               un point de MCLPO1 avec l'élément considéré.
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          : KRIPAD : MELEME -> (num. globale->locale)
  18. C APPELES (E/S)    : -
  19. C APPELES (BLAS)   : -
  20. C APPELES (CALCUL) : -
  21. C APPELE PAR       : ELPOEL
  22. C***********************************************************************
  23. C SYNTAXE GIBIANE    : -
  24. C ENTREES            : MCLAS (type MELEME)  : maillage de classe de
  25. C                                             points (sommet, face) par
  26. C                                             élément (MMAIL,ELTFA)
  27. C                      MCLPO1 (type MELEME) : maillage de points
  28. C                                             correspondant à MCLAS
  29. C                      MCENT  (type MELEME) : maillage des centres de
  30. C                                             MCLAS
  31. C                      LEPOEL (type MLELEM) :
  32. *                        NOPOI1 : indice du point considéré dans MCLPO1
  33. *                        LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)) :
  34. *                             contient le numéro du point considéré
  35. *                        LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)+1
  36. *                                   -> LEPOEL.INDEX(NOPOI1+1)-1) :
  37. *                             contient les numéro des points centre
  38. *                             des éléments contenant le point considéré
  39. C
  40. C ENTREES/SORTIES    : -
  41. C SORTIES            : ELNBEL (type MLENTI)
  42. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  43. C***********************************************************************
  44. C VERSION    : v1, 02/11/98, version initiale
  45. C HISTORIQUE : v1, 02/11/98, création
  46. C HISTORIQUE :
  47. C HISTORIQUE :
  48. C***********************************************************************
  49. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  50. C en cas de modification de ce sous-programme afin de faciliter
  51. C la maintenance !
  52. C***********************************************************************
  53.  
  54. -INC PPARAM
  55. -INC CCOPTIO
  56. -INC SMELEME
  57.       POINTEUR MCLAS.MELEME
  58.       POINTEUR MCLPO1.MELEME
  59.       POINTEUR MCENT.MELEME
  60. -INC SMLENTI
  61.       POINTEUR ELNBEL.MLENTI
  62.       POINTEUR KRIPO1.MLENTI
  63.       POINTEUR TMPCEN.MLENTI
  64. *
  65. *     Segment MLELEM
  66. *
  67.       SEGMENT MLELEM
  68.       INTEGER INDEX(NBL+1)
  69.       INTEGER LESPOI(NBTPOI)
  70.       ENDSEGMENT
  71. *
  72. *     LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  73. *
  74. *     NBL      : NOMBRE D'ELEMENTS
  75. *     NBTPOI   : NOMBRE TOTAL DE POINTS REFERENCEES
  76. *     INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  77. *                DANS LE TABLEAU LESPOI
  78. *     LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  79. *                DU IEME ELEMENT
  80. *
  81.       POINTEUR LEPOEL.MLELEM
  82.       INTEGER IMPR,IRET
  83.       LOGICAL LFOUND
  84. *
  85. * Executable statements
  86. *
  87.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans elenbl.eso'
  88.       SEGACT MCLPO1
  89.       NBSOUS=MCLPO1.LISOUS(/1)
  90.       NOTYP =MCLPO1.ITYPEL
  91.       IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  92.          WRITE(IOIMP,*) 'MCLPO1 must contain only POI1 elements'
  93.          GOTO 9999
  94.       ENDIF
  95. C     In KRIPAD : SEGINI KRIPO1
  96.       CALL KRIPAD(MCLPO1,KRIPO1)
  97.       NBPOI1=MCLPO1.NUM(/2)
  98.       SEGDES MCLPO1
  99.       SEGACT MCENT
  100.       NBSOUS=MCENT.LISOUS(/1)
  101.       NOTYP =MCENT.ITYPEL
  102.       IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  103.          WRITE(IOIMP,*) 'MCENT must contain only POI1 elements'
  104.          GOTO 9999
  105.       ENDIF
  106.       NBCENT=MCENT.NUM(/2)
  107.       JG=NBCENT
  108.       SEGINI ELNBEL
  109. *   On a besoin du max. du nombre de centres adjacents à un point
  110. *   de MCLPO1 pour avoir une estimation
  111. *   du nombre max de centres adjacents à l'élément en cours
  112.       SEGACT LEPOEL
  113.       NBLEPO=LEPOEL.INDEX(/1)-1
  114.       IF (NBLEPO.NE.NBPOI1) THEN
  115.          WRITE(IOIMP,*)
  116.      $        'Dimension of MCLPO1 and LEPOEL are not compatible'
  117.          GOTO 9999
  118.       ENDIF
  119.       MAPOCE=0
  120.       DO 1 INBL=1,NBLEPO
  121.          MAPOCE=MAX(MAPOCE,(LEPOEL.INDEX(INBL+1)-LEPOEL.INDEX(INBL)))
  122.  1    CONTINUE
  123. *   Dans LEPOEL, on a a la fois le point et les centre adjacents
  124.       MAPOCE=MAPOCE-1
  125. *   Parcourons le maillage géométrique
  126.       SEGACT MCLAS
  127.       NBSOUS=MCLAS.LISOUS(/1)
  128.       IF (NBSOUS.EQ.0) NBSOUS=1
  129.       ICENT=0
  130.       DO 2 INBSOU=1,NBSOUS
  131.          IF (NBSOUS.GT.1) THEN
  132.             IPT1=MCLAS.LISOUS(INBSOU)
  133.             SEGACT IPT1
  134.          ELSE
  135.             IPT1=MCLAS
  136.          ENDIF
  137.          NBPOEL=IPT1.NUM(/1)
  138.          NBELEM=IPT1.NUM(/2)
  139.          JG=NBPOEL*MAPOCE
  140. *     TMPCEN sert à stocker les centres adajacents à l'élément
  141. *     en cours. Il faut faire attention à ne pas stocker deux
  142. *     fois le meme numéro de centre.
  143.          SEGINI TMPCEN
  144.          DO 22 INBEL=1,NBELEM
  145.             ICENT=ICENT+1
  146.             ITMPC=1
  147. *     On stocke le centre de l'élément considéré en premier
  148.             TMPCEN.LECT(ITMPC)=MCENT.NUM(1,ICENT)
  149.             DO 222 INBPO=1,NBPOEL
  150.                NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL))
  151.                IF (NOPOI1.NE.0) THEN
  152.                   DO 2222 IPOCE=LEPOEL.INDEX(NOPOI1)+1,
  153.      $                          LEPOEL.INDEX(NOPOI1+1)-1
  154.                      NUMCEN=LEPOEL.LESPOI(IPOCE)
  155.                      IBTMPC=1
  156. *     On cherche si le centre de numéro NUMCEN n'est pas deja
  157. *     dans la liste TMPCEN
  158. 22222                CONTINUE
  159.                      LFOUND=(NUMCEN.EQ.TMPCEN.LECT(IBTMPC))
  160.                      IF (.NOT.LFOUND.AND.(IBTMPC.LT.ITMPC)) THEN
  161.                         IBTMPC=IBTMPC+1
  162.                         GOTO 22222
  163.                      ENDIF
  164. *     Il n'est pas dans la liste, on le rajoute
  165.                      IF (.NOT.LFOUND) THEN
  166.                         ITMPC=ITMPC+1
  167.                         TMPCEN.LECT(ITMPC)=NUMCEN
  168.                      ENDIF
  169.  2222             CONTINUE
  170.                ELSE
  171.                   WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas'
  172.                   WRITE(IOIMP,*) 'le maillage de points correspondant'
  173.                   WRITE(IOIMP,*) 'à MCLAS.'
  174.                ENDIF
  175.  222        CONTINUE
  176. *     ITMPC-1 car TMPCEN contient aussi le centre de l'élément
  177. *     courant
  178.             ELNBEL.LECT(ICENT)=ITMPC-1
  179.  22      CONTINUE
  180.          IF (NBSOUS.GT.1) SEGDES IPT1
  181.          SEGSUP TMPCEN
  182.  2    CONTINUE
  183.       SEGDES MCLAS
  184.       SEGDES LEPOEL
  185.       SEGDES MCENT
  186.       SEGSUP KRIPO1
  187.       IF (IMPR.GT.2) THEN
  188.          WRITE(IOIMP,*) 'On a créé ELNBEL (type MLENTI)=',ELNBEL
  189.          IF (IMPR.GT.3) THEN
  190.             WRITE(IOIMP,4000) 'ELNBEL',NBCENT
  191.             WRITE(IOIMP,5000) (ELNBEL.LECT(I),I=1,NBCENT)
  192.          ENDIF
  193.       ENDIF
  194.       SEGDES ELNBEL
  195. *
  196. * Normal termination
  197. *
  198.       IRET=0
  199.       RETURN
  200. *
  201. * Format handling
  202. *
  203.  4000  FORMAT (A,'(1..',I8,')')
  204.  5000  FORMAT (8(1X,I8))
  205. *
  206. * Error handling
  207. *
  208.  9999 CONTINUE
  209.       IRET=1
  210.       WRITE(IOIMP,*) 'An error was detected in subroutine elenbl'
  211.       RETURN
  212. *
  213. * End of subroutine ELENBL
  214. *
  215.       END
  216.  
  217.  
  218.  
  219.  

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