Télécharger la plaquette Cast3M


fr en

Télécharger ponbl2.eso

Retour à la liste

Numérotation des lignes : 

ponbl2

  1. C PONBL2    SOURCE    CB215821  19/08/20    21:20:22     10287          
  2.       SUBROUTINE PONBL2(MAIL,KRIPO1,NPOMAX,
  3.      $     PONBEL,IMPR,IRET)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM         : PONBL2
  8. C DESCRIPTION : Maillage + tableau repérage de points => liste d'entiers
  9. C               (un point)->(nb. d'éléments du maillage le contenant).
  10. C
  11. C               Construit une liste d'entiers : PONBEL (type MLENTI)
  12. C               PONBEL(i) est le nombre d'éléments de MAIL
  13. C               contenant un point dont le numéro n
  14. C               est tel que KRIPO1(n)=i.
  15. C               La dimension de PONBEL est NPOMAX
  16. C
  17. C LANGAGE     : ESOPE
  18. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  19. C               mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES          :
  22. C APPELE PAR       : MAKPRM
  23. C***********************************************************************
  24. C SYNTAXE GIBIANE    : -
  25. C ENTREES            :
  26. C ENTREES/SORTIES    : -
  27. C SORTIES            : PONBEL (type MLENTI)
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION    : v1, 20/05/99, version initiale
  31. C HISTORIQUE : v1, 20/05/99, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC SMELEME
  43.       POINTEUR MAIL.MELEME
  44.       POINTEUR SOUMAI.MELEME
  45. -INC SMLENTI
  46.       INTEGER JG
  47.       POINTEUR PONBEL.MLENTI
  48.       POINTEUR KRIPO1.MLENTI
  49. *
  50.       INTEGER IMPR,IRET
  51.       INTEGER MAETA,KRETA,SMETA
  52.       INTEGER INBEL,INBNO,INBSOU
  53.       INTEGER  NBEL, NBNO,NBSOUS,NUMNO,NLOCP1,NPOMAX
  54. *
  55. * Executable statements
  56. *
  57.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ponbl2.eso'
  58.       CALL OOOETA(KRIPO1,KRETA,IMOD)
  59.       IF (KRETA.NE.1) SEGACT KRIPO1
  60.       JG=NPOMAX
  61.       SEGINI PONBEL
  62. *
  63. *   Parcourons le maillage
  64. *
  65.       CALL OOOETA(MAIL,MAETA,IMOD)
  66.       IF (MAETA.NE.1) SEGACT MAIL
  67.       NBSOUS=MAX(1,MAIL.LISOUS(/1))
  68.       DO 1 INBSOU=1,NBSOUS
  69.          IF (NBSOUS.EQ.1) THEN
  70.             SOUMAI=MAIL
  71.          ELSE
  72.             SOUMAI=MAIL.LISOUS(INBSOU)
  73.             CALL OOOETA(SOUMAI,SMETA,IMOD)
  74.             IF (SMETA.NE.1) SEGACT SOUMAI
  75.          ENDIF
  76.          NBNO=SOUMAI.NUM(/1)
  77.          NBEL=SOUMAI.NUM(/2)
  78.          DO 12 INBEL=1,NBEL
  79.             DO 122 INBNO=1,NBNO
  80.                NUMNO=SOUMAI.NUM(INBNO,INBEL)
  81.                NLOCP1=KRIPO1.LECT(NUMNO)
  82.                IF (NLOCP1.NE.0) THEN
  83.                   PONBEL.LECT(NLOCP1)=PONBEL.LECT(NLOCP1)+1
  84.                ENDIF
  85.  122        CONTINUE
  86.  12      CONTINUE
  87.  1    CONTINUE
  88. *
  89. * Normal termination
  90. *
  91.       IRET=0
  92.       RETURN
  93. *
  94. * Format handling
  95. *
  96. *
  97. * Error handling
  98. *
  99.  9999 CONTINUE
  100.       IRET=1
  101.       WRITE(IOIMP,*) 'An error was detected in subroutine ponbl2'
  102. *
  103. * End of subroutine PONBL2
  104. *
  105.       END
  106.  
  107.  
  108.  

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