Télécharger la plaquette Cast3M


fr en

Télécharger poelm2.eso

Retour à la liste

Numérotation des lignes : 

poelm2

  1. C POELM2    SOURCE    GOUNAND   25/04/30    21:15:26     12258          
  2.       SUBROUTINE POELM2(MAIL,KRIPO1,PONBEL,
  3.      $     LSTPL,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : POELM2
  9. C DESCRIPTION : Maillage + tableau de repérage de points + liste
  10. C               d'entiers (ponbl2) => liste indexée d'entiers (un
  11. C               point)->(numéro des éléments du maillage le contenant).
  12. C
  13. C         Construit une liste indexée LSTPL (type LSTIND)
  14. C         * Nombre de multiplets = nb d'éléments de PONBEL ;
  15. C         * chaque multiplet i : numéros des éléments de
  16. C           MAIL contenant un point dont le numéro n
  17. C           est tel que KRIPO1(n)=i.
  18. C       (Le nombre de ces éléments est PONBEL(i), cf. ponbl2).
  19. C
  20. C LANGAGE     : ESOPE
  21. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  22. C               mél : gounand@semt2.smts.cea.fr
  23. C***********************************************************************
  24. C APPELES (ESOPE)  : OOOETA
  25. C APPELE PAR       : MAKPRM
  26. C***********************************************************************
  27. C SYNTAXE GIBIANE    : -
  28. C ENTREES            :
  29. C ENTREES/SORTIES    : -
  30. C SORTIES            : LSTPL (type LSTIND)
  31. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  32. C***********************************************************************
  33. C VERSION    : v1, 20/05/99, version initiale
  34. C HISTORIQUE : v1, 20/05/99, 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.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC SMELEME
  46.       POINTEUR MAIL.MELEME
  47.       POINTEUR SOUMAI.MELEME
  48. -INC SMLENTI
  49.       POINTEUR PONBEL.MLENTI
  50.       POINTEUR KRIPO1.MLENTI
  51. *
  52. *     Segment LSTIND (liste séquentielle indexée)
  53. *
  54.       SEGMENT LSTIND
  55.       INTEGER IDX(NBM+1)
  56.       INTEGER IVAL(NBTVAL)
  57.       ENDSEGMENT
  58. *
  59. *     LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  60. *
  61. *     NBL      : NOMBRE DE MULTIPLETS
  62. *     NBTVAL   : NOMBRE TOTAL DE VALEURS
  63. *     IDX(I)   : INDICE DE LA PREMIERE VALEUR DU IEME
  64. *                MULTIPLET DANS LE TABLEAU IVAL
  65. *     IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  66. *
  67. *-INC SLSTIND
  68.       POINTEUR LSTPL.LSTIND
  69.       POINTEUR ICOUR.LSTIND
  70. *
  71.       INTEGER IMPR,IRET
  72.       INTEGER MAETA,KRETA,POETA,SMETA
  73.       INTEGER INBEL,INBM,INBNO,INBSOU,IDEPA,IDXCOU
  74.       INTEGER  NBEL, NBM, NBNO,NBSOUS
  75.       INTEGER NBTVAL,NLOCP1,NPONB,NUELMA,NUMNO
  76. *
  77. * Executable statements
  78. *
  79.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans poelm2.eso'
  80.       SEGACT PONBEL
  81.       NPONB=PONBEL.LECT(/1)
  82. C   On initialise le segment LSTPL
  83. C              et le segment ICOUR
  84. C     dans ICOUR, seul le tableau IDX nous intéresse
  85.       NBM=NPONB
  86.       NBTVAL=0
  87.       SEGINI LSTPL
  88.       IDEPA=1
  89.       DO 2 INBM=1,NBM
  90.          LSTPL.IDX(INBM)=IDEPA
  91.          IDEPA=IDEPA+PONBEL.LECT(INBM)
  92.  2    CONTINUE
  93.       LSTPL.IDX(NBM+1)=IDEPA
  94.       SEGINI,ICOUR=LSTPL
  95.       NBTVAL=IDEPA-1
  96.       SEGADJ LSTPL
  97.       SEGACT KRIPO1
  98. *
  99. *   Parcourons le maillage
  100. *
  101.       NUELMA=0
  102.       SEGACT MAIL
  103.       NBSOUS=MAX(1,MAIL.LISOUS(/1))
  104.       DO 4 INBSOU=1,NBSOUS
  105.          IF (NBSOUS.EQ.1) THEN
  106.             SOUMAI=MAIL
  107.          ELSE
  108.             SOUMAI=MAIL.LISOUS(INBSOU)
  109.             SEGACT SOUMAI
  110.          ENDIF
  111.          NBNO=SOUMAI.NUM(/1)
  112.          NBEL=SOUMAI.NUM(/2)
  113.          DO 42 INBEL=1,NBEL
  114.             NUELMA=NUELMA+1
  115.             DO 422 INBNO=1,NBNO
  116.                NUMNO=SOUMAI.NUM(INBNO,INBEL)
  117.                NLOCP1=KRIPO1.LECT(NUMNO)
  118.                IF (NLOCP1.NE.0) THEN
  119.                   IDXCOU=ICOUR.IDX(NLOCP1)
  120.                   LSTPL.IVAL(IDXCOU)=NUELMA
  121.                   ICOUR.IDX(NLOCP1)=IDXCOU+1
  122.                ENDIF
  123.  422        CONTINUE
  124.  42      CONTINUE
  125.  4    CONTINUE
  126.       SEGSUP ICOUR
  127. *
  128. * Normal termination
  129. *
  130.       IRET=0
  131.       RETURN
  132. *
  133. * Format handling
  134. *
  135. *
  136. * Error handling
  137. *
  138.  9999 CONTINUE
  139.       IRET=1
  140.       WRITE(IOIMP,*) 'An error was detected in subroutine poelm2'
  141. *
  142. * End of subroutine POELM2
  143. *
  144.       END
  145.  
  146.  

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