Télécharger la plaquette Cast3M


fr en

Télécharger prex1d.eso

Retour à la liste

Numérotation des lignes : 

prex1d

  1. C PREX1D    SOURCE    BP208322  16/11/18    21:20:07     9177           
  2.  
  3. C=======================================================================
  4. C=                             P R E X 1 D                             =
  5. C=                             -----------                             =
  6. C=  Ce sousprogramme determine les "extremites" d'un maillage 1D.      =
  7. C=  Il est l'image en 1D des sousprogrammes PRCONT (2D) et PRENVE (3D).=
  8. C=  Il est appele par les operateurs FLUX et PRESSION.                 =
  9. C=======================================================================
  10.  
  11.       SUBROUTINE PREX1D
  12.  
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8 (A-H,O-Z)
  15.  
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC CCGEOME
  20. -INC SMELEME
  21. -INC SMLENTI
  22.  
  23. C*    IF (IDIM.NE.1) THEN
  24. C*      CALL ERREUR(xx)
  25. C*      RETURN
  26. C*    ENDIF
  27.  
  28. C= Travail sur un maillage avec des SEG2 et/ou des POI
  29. C= C'est suffisant pour recuperer les points extremites
  30.       CALL CHANLI
  31.       IF (IERR.NE.0) RETURN
  32.       CALL LIROBJ('MAILLAGE',ipmail,1,iOK)
  33.       IF (IERR.NE.0) RETURN
  34.  
  35. C= On determine les composantes connexes du maillage
  36. C= CCON cree un nouveau maillage, meme si ipmail est elementaire.
  37. C= On peut donc detruire les maillages pointes dans ilect.
  38.       CALL CCON1(ipmail,ilect)
  39.       IF (IERR.NE.0) RETURN
  40.  
  41. C= On a alors au plus extremites = dimension de ilect * 2
  42.       MLENT1=ilect
  43.       SEGACT,MLENT1
  44.       IG=MLENT1.LECT(/1)
  45.       JG=2*IG
  46.       SEGINI,MLENTI
  47.       NBEXT=0
  48. C= Recuperation des points extremites
  49. C= On ordonne le maillage de SEG2.
  50. C= Dans le cas ou la composante connexe retournee par CCON contient
  51. C= plusieurs objets (normalement 2 de type POI1 et SEG2), les elements
  52. C= POI1 sont en fait des noeuds inclus dans le maillage SEG2, qui ne
  53. C= necessitent donc pas de traitement.
  54.       DO i=1,IG
  55.         IPT1=MLENT1.LECT(i)
  56.         SEGACT,IPT1
  57.         NSous=IPT1.LISOUS(/1)
  58.         IF (NSous.NE.0) THEN
  59. C*        MELEME=0
  60.           DO j=1,NSous
  61.             IPT2=IPT1.LISOUS(j)
  62.             SEGACT,IPT2
  63.             IF (IPT2.ITYPEL.EQ.2) MELEME=IPT2
  64.             SEGDES,IPT2
  65.           ENDDO
  66. C*        IF (MELEME.EQ.0) --> ERREUR (a finir)
  67.           SEGACT,MELEME
  68.         ELSE
  69.           MELEME=IPT1
  70.         ENDIF
  71.         IF (ITYPEL.EQ.1) THEN
  72.           NBEXT=NBEXT+1
  73.           LECT(NBEXT)=NUM(1,1)
  74.         ELSE IF (ITYPEL.EQ.2) THEN
  75.           CALL ORDON4(MELEME)
  76.           SEGACT,MELEME
  77.           NBEXT=NBEXT+1
  78.           LECT(NBEXT)=NUM(1,1)
  79.           NBEXT=NBEXT+1
  80.           LECT(NBEXT)=NUM(2,NUM(/2))
  81.         ENDIF
  82.         SEGSUP,IPT1
  83.       ENDDO
  84.  
  85. C= Initialisation du maillage de POI1 resultat
  86.       NBNN=1
  87.       NBELEM=NBEXT
  88.       NBSOUS=0
  89.       NBREF=0
  90.       SEGINI,MELEME
  91. C= Remplissage du maillage
  92.       ITYPEL=1
  93.       DO i=1,NBEXT
  94.         NUM(1,i)=LECT(i)
  95.         ICOLOR(i)=IDCOUL
  96.       ENDDO
  97.       SEGDES,MELEME
  98. C= Ecriture du maillage resultat
  99.       ipmail=MELEME
  100.       CALL ECROBJ('MAILLAGE',ipmail)
  101.  
  102. C= Un peu de menage
  103.       SEGSUP,MLENT1,MLENTI
  104.  
  105.       RETURN
  106.       END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  

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