Esope source files

   1 : C PREX1D    SOURCE    CHAT      07/10/29    21:25:56     5940           
   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 : -INC CCOPTIO
  17 : -INC CCGEOME
  18 : -INC SMELEME
  19 : -INC SMLENTI
  20 : 
  21 : C*    IF (IDIM.NE.1) THEN
  21 : C*      CALL ERREUR(xx)
  22 : C*      RETURN
  23 : C*    ENDIF
  24 : 
  25 : C= Travail sur un maillage avec des SEG2 et/ou des POI
  26 : C= C'est suffisant pour recuperer les points extremites
  26 :       CALL CHANLI
  27 :       IF (IERR.NE.0) RETURN
  27 :       CALL LIROBJ('MAILLAGE',ipmail,1,iOK)
  28 :       IF (IERR.NE.0) RETURN
  29 : 
  30 : C= On determine les composantes connexes du maillage
  31 : C= CCON cree un nouveau maillage, meme si ipmail est elementaire.
  32 : C= On peut donc detruire les maillages pointes dans ilect.
  32 :       CALL CCON1(ipmail,ilect)
  33 :       IF (IERR.NE.0) RETURN
  34 : 
  35 : C= On a alors au plus extremites = dimension de ilect * 2
  36 :       MLENT1=ilect
  37 :       SEGACT,MLENT1
  38 :       IG=MLENT1.LECT(/1)
  39 :       JG=2*IG
  40 :       SEGINI,MLENTI
  41 :       NBEXT=0
  42 : C= Recuperation des points extremites
  43 : C= On ordonne le maillage de SEG2.
  44 : C= Dans le cas ou la composante connexe retournee par CCON contient
  45 : C= plusieurs objets (normalement 2 de type POI1 et SEG2), les elements
  46 : C= POI1 sont en fait des noeuds inclus dans le maillage SEG2, qui ne
  47 : C= necessitent donc pas de traitement.
  48 :       DO i=1,IG
  49 :         IPT1=MLENT1.LECT(i)
  50 :         SEGACT,IPT1
  51 :         NSous=IPT1.LISOUS(/1)
  52 :         IF (NSous.NE.0) THEN
  53 : C*        MELEME=0
  54 :           DO j=1,NSous
  55 :             IPT2=IPT1.LISOUS(j)
  56 :             SEGACT,IPT2
  57 :             IF (IPT2.ITYPEL.EQ.2) MELEME=IPT2
  58 :             SEGDES,IPT2
  59 :           ENDDO
  60 : C*        IF (MELEME.EQ.0) --> ERREUR (a finir)
  61 :           SEGACT,MELEME
  62 :         ELSE
  63 :           MELEME=IPT1
  64 :         ENDIF
  65 :         IF (ITYPEL.EQ.1) THEN
  66 :           NBEXT=NBEXT+1
  67 :           LECT(NBEXT)=NUM(1,1)
  68 :         ELSE IF (ITYPEL.EQ.2) THEN
  68 :           CALL ORDON4(MELEME)
  69 :           SEGACT,MELEME
  70 :           NBEXT=NBEXT+1
  71 :           LECT(NBEXT)=NUM(1,1)
  72 :           NBEXT=NBEXT+1
  73 :           LECT(NBEXT)=NUM(2,NUM(/2))
  74 :         ENDIF
  75 :         SEGSUP,IPT1
  76 :       ENDDO
  77 : 
  78 : C= Initialisation du maillage de POI1 resultat
  79 :       NBNN=1
  80 :       NBELEM=NBEXT
  81 :       NBSOUS=0
  82 :       NBREF=0
  83 :       SEGINI,MELEME
  84 : C= Remplissage du maillage
  85 :       ITYPEL=1
  86 :       DO i=1,NBEXT
  87 :         NUM(1,i)=LECT(i)
  88 :         ICOLOR(i)=IDCOUL
  89 :       ENDDO
  90 :       SEGDES,MELEME
  91 : C= Ecriture du maillage resultat
  92 :       ipmail=MELEME
  92 :       CALL ECROBJ('MAILLAGE',ipmail)
  93 : 
  94 : C= Un peu de menage
  95 :       SEGSUP,MLENT1,MLENTI
  96 : 
  97 :       RETURN
  98 :       END
  99 : 
 100 :  
 101 :  
 102 :  
 103 :