Télécharger la plaquette Cast3M


fr en

Télécharger poinbl.eso

Retour à la liste

Numérotation des lignes : 

poinbl

  1. C POINBL    SOURCE    CHAT      05/01/13    02:16:47     5004
  2.       SUBROUTINE POINBL(MCLAS,MCLPO1,
  3.      $     PONBEL,IMPR,IRET)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM         : POINBL
  8. C DESCRIPTION : Construit une liste d'entiers : PONBEL (type MLENTI)
  9. C               PONBEL(i) est le nombre d'éléments de MCLAS
  10. C               contenant le ieme point du maillage MCLPO1.
  11. C               MCLPO1 est un maillage de POI1.
  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       : POIELE, 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 ENTREES/SORTIES    : -
  30. C SORTIES            : PONBEL (type MLENTI)
  31. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  32. C***********************************************************************
  33. C VERSION    : v1, 29/10/98, version initiale
  34. C HISTORIQUE : v1, 29/10/98, création
  35. C HISTORIQUE :
  36. C HISTORIQUE :
  37. C***********************************************************************
  38. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  39. C en cas de modification de ce sous-programme afin de faciliter
  40. C la maintenance !
  41. C***********************************************************************
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC SMELEME
  45.       POINTEUR MCLAS.MELEME
  46.       POINTEUR MCLPO1.MELEME
  47. -INC SMLENTI
  48.       POINTEUR PONBEL.MLENTI
  49.       POINTEUR KRIPO1.MLENTI
  50. *
  51. * Executable statements
  52. *
  53.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans poinbl.eso'
  54.       SEGACT MCLPO1
  55.       NBSOUS=MCLPO1.LISOUS(/1)
  56.       NOTYP =MCLPO1.ITYPEL
  57.       IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  58.          WRITE(IOIMP,*) 'MCLPO1 must contain only POI1 elements'
  59.          GOTO 9999
  60.       ENDIF
  61. C     In KRIPAD : SEGINI KRIPO1
  62.       CALL KRIPAD(MCLPO1,KRIPO1)
  63.       NBPOI1=MCLPO1.NUM(/2)
  64.       SEGDES MCLPO1
  65.       JG=NBPOI1
  66.       SEGINI PONBEL
  67. *
  68. *   Parcourons le maillage géométrique des classes de points
  69. *
  70.       SEGACT MCLAS
  71.       NBSOUS=MCLAS.LISOUS(/1)
  72.       IF (NBSOUS.EQ.0) NBSOUS=1
  73.       DO 1 INBSOU=1,NBSOUS
  74.          IF (NBSOUS.GT.1) THEN
  75.             IPT1=MCLAS.LISOUS(INBSOU)
  76.             SEGACT IPT1
  77.          ELSE
  78.             IPT1=MCLAS
  79.          ENDIF
  80.          NBPOEL=IPT1.NUM(/1)
  81.          NBELEM=IPT1.NUM(/2)
  82.          DO 12 INBEL=1,NBELEM
  83.             DO 122 INBPO=1,NBPOEL
  84.                NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL))
  85.                IF (NOPOI1.NE.0) THEN
  86.                   PONBEL.LECT(NOPOI1)=PONBEL.LECT(NOPOI1)+1
  87.                ELSE
  88.                   WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas'
  89.                   WRITE(IOIMP,*) 'le maillage de points correspondant'
  90.                   WRITE(IOIMP,*) 'à MCLAS.'
  91.                   GOTO 9999
  92.                ENDIF
  93.  122        CONTINUE
  94.  12      CONTINUE
  95.          IF (NBSOUS.GT.1) SEGDES IPT1
  96.  1    CONTINUE
  97.       SEGDES MCLAS
  98.       SEGSUP KRIPO1
  99.       IF (IMPR.GT.2) THEN
  100.          WRITE(IOIMP,*) 'On a créé PONBEL=',PONBEL
  101.          IF (IMPR.GT.3) THEN
  102.             WRITE(IOIMP,4000) 'PONBEL',NBPOI1
  103.             WRITE(IOIMP,5000) (PONBEL.LECT(I),I=1,NBPOI1)
  104.          ENDIF
  105.       ENDIF
  106.       SEGDES PONBEL
  107. *
  108. * Normal termination
  109. *
  110.       IRET=0
  111.       RETURN
  112. *
  113. * Format handling
  114. *
  115.  4000  FORMAT (A,'(1..',I8,')')
  116.  5000  FORMAT (8(1X,I8))
  117. *
  118. * Error handling
  119. *
  120.  9999 CONTINUE
  121.       IRET=1
  122.       WRITE(IOIMP,*) 'An error was detected in subroutine poinbl'
  123.       RETURN
  124. *
  125. * End of subroutine POINBL
  126. *
  127.       END
  128.  
  129.  
  130.  
  131.  

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