Télécharger la plaquette Cast3M


fr en

Télécharger rpelen.eso

Retour à la liste

Numérotation des lignes : 

rpelen

  1. C RPELEN    SOURCE    CHAT      05/01/13    03:06:46     5004
  2.       SUBROUTINE RPELEN(MTOUT,KRPOIN,
  3.      $     LELEM,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : RPELEN
  9. C DESCRIPTION : On repère les éléments d'un maillage qui contiennent (au
  10. C               moins) un point d'une liste de points.
  11. C
  12. C               On repère les éléments de MTOUT qui contiennent au moins
  13. C               un point tel que KRPOIN(po_elem).NE.0
  14. C
  15. C
  16. C LANGAGE     : ESOPE
  17. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18. C               mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES          : NBDEL
  21. C APPELE PAR       : PROMAT
  22. C***********************************************************************
  23. C ENTREES            : MTOUT, KRPOIN
  24. C SORTIES            : LELEM
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION    : v1, 02/02/2000, version initiale
  28. C HISTORIQUE : v1, 02/02/2000, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC SMELEME
  40.       POINTEUR MTOUT.MELEME
  41.       POINTEUR SOUMT.MELEME
  42. -INC SMLENTI
  43.       POINTEUR KRPOIN.MLENTI
  44.       INTEGER JG
  45.       POINTEUR LELEM.MLENTI
  46. *
  47.       INTEGER IMPR,IRET
  48. *
  49.       INTEGER NEL,NNO,NSOUS,NELMT
  50.       INTEGER IEL,INO,ISOUS,IELMT
  51.       INTEGER IELEM,NUNO
  52. *
  53. * Executable statements
  54. *
  55.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rpelen.eso'
  56.       CALL NBDEL(MTOUT,NELMT,IMPR,IRET)
  57.       IF (IRET.NE.0) GOTO 9999
  58.       JG=NELMT
  59.       SEGINI LELEM
  60.       SEGACT KRPOIN
  61.       SEGACT MTOUT
  62. * Parcourons le maillage
  63.       IELMT=0
  64.       IELEM=0
  65.       NSOUS=MAX(1,MTOUT.LISOUS(/1))
  66.       DO 1 ISOUS=1,NSOUS
  67.          IF (NSOUS.EQ.1) THEN
  68.             SOUMT=MTOUT
  69.          ELSE
  70.             SOUMT=MTOUT.LISOUS(ISOUS)
  71.             SEGACT SOUMT
  72.          ENDIF
  73.          NNO=SOUMT.NUM(/1)
  74.          NEL=SOUMT.NUM(/2)
  75.          DO 12 IEL=1,NEL
  76.             INO=1
  77.             IELMT=IELMT+1
  78.  122        CONTINUE
  79.             NUNO=SOUMT.NUM(INO,IEL)
  80.             IF (KRPOIN.LECT(NUNO).NE.0) THEN
  81.                IELEM=IELEM+1
  82.                LELEM.LECT(IELEM)=IELMT
  83.             ELSE
  84.                INO=INO+1
  85.                IF (INO.LE.NNO) GOTO 122
  86.             ENDIF
  87.  12      CONTINUE
  88.          IF (NSOUS.NE.1) THEN
  89.             SEGDES SOUMT
  90.          ENDIF
  91.  1    CONTINUE
  92.       SEGDES MTOUT
  93.       SEGDES KRPOIN
  94.       JG=IELEM
  95.       SEGADJ,LELEM
  96.       SEGDES LELEM
  97. *
  98. * Normal termination
  99. *
  100.       IRET=0
  101.       RETURN
  102. *
  103. * Format handling
  104. *
  105. *
  106. * Error handling
  107. *
  108.  9999 CONTINUE
  109.       IRET=1
  110.       WRITE(IOIMP,*) 'An error was detected in subroutine rpelen'
  111.       RETURN
  112. *
  113. * End of subroutine RPELEN
  114. *
  115.       END
  116.  
  117.  
  118.  
  119.  

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