Télécharger la plaquette Cast3M


fr en

Télécharger popoin.eso

Retour à la liste

Numérotation des lignes : 

popoin

  1. C POPOIN    SOURCE    GOUNAND   25/04/30    21:15:27     12258          
  2.       SUBROUTINE POPOIN(P2ELPR,MELDUA,POPPOD,
  3.      $     LPPPD,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : POPOIN
  9. C DESCRIPTION : Maillage + liste indexée d'entiers (poelm2) + liste
  10. C               d'entiers (ponbpo) => liste indexée d'entiers (un
  11. C               point)->(numéro des points adjacents).
  12. C
  13. C     - Construire la liste indexée suivante (LPPPD) :
  14. C         * Nombre de multiplets = nb points P1 de MELPRI
  15. C         * pour chaque P1 : numéro des points P2 de MELDUA avec
  16. C           lesquels il a une liaison.
  17. C
  18. C LANGAGE     : ESOPE
  19. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  20. C               mél : gounand@semt2.smts.cea.fr
  21. C***********************************************************************
  22. C APPELES (ESOPE)  : OOOETA
  23. C APPELES          : ACTMEL, INIRPL, RPELEM, DESMEL
  24. C APPELE PAR       : MAKPRM
  25. C***********************************************************************
  26. C ENTREES            : P2ELPR, MELDUA, POPPOD
  27. C SORTIES            : LPPPD
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION    : v2, 15/12/99
  31. C HISTORIQUE : v1, 06/10/99, création
  32. C HISTORIQUE : v2, 15/12/99, utilisation de liste chaînées
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37. C en cas de modification de ce sous-programme afin de faciliter
  38. C la maintenance !
  39. C***********************************************************************
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC SMCOORD
  44. -INC SMELEME
  45.       POINTEUR MELDUA.MELEME
  46.       POINTEUR SOUMDU.MELEME
  47. -INC SMLENTI
  48.       INTEGER JG
  49.       POINTEUR POPPOD.MLENTI
  50.       POINTEUR RPDUAL.MLENTI
  51.       POINTEUR IWORK.MLENTI
  52. *
  53. * Includes persos
  54. *
  55. *-INC SLSTIND
  56. *
  57. *     Segment LSTIND (liste séquentielle indexée)
  58. *
  59.       SEGMENT LSTIND
  60.       INTEGER IDX(NBM+1)
  61.       INTEGER IVAL(NBTVAL)
  62.       ENDSEGMENT
  63. *
  64. *     LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  65. *
  66. *     NBM      : NOMBRE DE MULTIPLETS
  67. *     NBTVAL   : NOMBRE TOTAL DE VALEURS
  68. *     IDX(I)   : INDICE DE LA PREMIERE VALEUR DU IEME
  69. *                MULTIPLET DANS LE TABLEAU IVAL
  70. *     IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  71.       POINTEUR P2ELPR.LSTIND
  72.       POINTEUR LPPPD.LSTIND
  73. *
  74.       INTEGER IMPR,IRET
  75. *
  76.       INTEGER POETA,P2LETA
  77.       INTEGER ILPPPD,IDEPA,IELDUA,IPLDU,IPPRI
  78.       INTEGER NBTVAL,NOELDU,NOSODU,NPODUA,NBPLDU,NPPRI,NUMELD,NBM
  79. *
  80. * Executable statements
  81. *
  82.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans popoin.eso'
  83.       SEGACT POPPOD
  84.       NPPRI=POPPOD.LECT(/1)
  85. C   On initialise le segment LPPPD
  86.       NBM=NPPRI
  87.       NBTVAL=0
  88.       SEGINI LPPPD
  89.       IDEPA=1
  90.       DO 2 IPPRI=1,NPPRI
  91.          LPPPD.IDX(IPPRI)=IDEPA
  92.          IDEPA=IDEPA+POPPOD.LECT(IPPRI)
  93.  2    CONTINUE
  94.       LPPPD.IDX(NPPRI+1)=IDEPA
  95.       NBTVAL=IDEPA-1
  96.       SEGADJ LPPPD
  97. * Activations
  98.       SEGACT P2ELPR
  99.       JG=nbpts
  100.       SEGINI IWORK
  101.       CALL ACTMEL(MELDUA)
  102. * In INIRPL : SEGINI RPDUAL
  103.       CALL INIRPL(MELDUA,
  104.      $     RPDUAL,
  105.      $     IMPR,IRET)
  106.       IF (IRET.NE.0) GOTO 9999
  107. *
  108. *   Parcourons le maillage
  109. *
  110.       DO 5 IPPRI=1,NPPRI
  111.          ILPPPD=LPPPD.IDX(IPPRI)-1
  112.          DO 52 IELDUA=P2ELPR.IDX(IPPRI),
  113.      $                P2ELPR.IDX(IPPRI+1)-1
  114.             NUMELD=P2ELPR.IVAL(IELDUA)
  115.             CALL RPELEM(NUMELD,RPDUAL,
  116.      $           NOSODU,NOELDU,
  117.      $           IMPR,IRET)
  118.             IF (IRET.NE.0) GOTO 9999
  119.             IF (NOSODU.NE.0) THEN
  120.                SOUMDU=MELDUA.LISOUS(NOSODU)
  121.             ELSE
  122.                SOUMDU=MELDUA
  123.             ENDIF
  124.             NBPLDU=SOUMDU.NUM(/1)
  125.             DO 522 IPLDU=1,NBPLDU
  126.                NPODUA=SOUMDU.NUM(IPLDU,NOELDU)
  127.                IF (IWORK.LECT(NPODUA).EQ.0) THEN
  128.                   ILPPPD=ILPPPD+1
  129.                   LPPPD.IVAL(ILPPPD)=NPODUA
  130.                   IWORK.LECT(NPODUA)=ILPPPD
  131.                ENDIF
  132.  522        CONTINUE
  133.  52      CONTINUE
  134. *     On remet le segment de travail à zéro
  135.          DO 54 ILPPPD=LPPPD.IDX(IPPRI),LPPPD.IDX(IPPRI+1)-1
  136.             IWORK.LECT(LPPPD.IVAL(ILPPPD))=0
  137.  54      CONTINUE
  138.  5    CONTINUE
  139.       SEGSUP RPDUAL
  140.       SEGSUP IWORK
  141. *
  142. * Normal termination
  143. *
  144.       IRET=0
  145.       RETURN
  146. *
  147. * Format handling
  148. *
  149. *
  150. * Error handling
  151. *
  152.  9999 CONTINUE
  153.       IRET=1
  154.       WRITE(IOIMP,*) 'An error was detected in subroutine popoin'
  155.       RETURN
  156. *
  157. * End of subroutine POPOIN
  158. *
  159.       END
  160.  
  161.  

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