Télécharger la plaquette Cast3M


fr en

Télécharger trjpri.eso

Retour à la liste

Numérotation des lignes : 

trjpri

  1. C TRJPRI    SOURCE    CHAT      05/01/13    03:50:42     5004
  2.       SUBROUTINE TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,J,IEL,INOELO,TLI,
  3.      * ITRI )
  4. C
  5. C**********************************************************************
  6. C
  7. C   OBJET  : CE SOUS-PROGRAMME CALCULE L'APPARTENANCE DE POINTS A UN
  8. C   -----    ELEMENT PRISME D'UN MAILLAGE M1.
  9. C
  10. C   ARGUMENTS:
  11. C   ---------
  12. C
  13. C   ENTREE  :  IZNOEU = POINTEUR DU SEGMENT CONTENANT LES COORDONNEES
  14. C                       ET LES NUMEROS DES NOEUDS DE L ELEMENT COURANT
  15. C              IZTRAV = POINTEUR DU SEGMENT CONTENANT LES COORDONNEES
  16. C                       DES POINTS DONT ON CHERCHE L'APPARTENANCE
  17. C              IZAPAR = POINTEUR DU SEGMENT QUI CONTIENDRA LES
  18. C                       APPARTENANCES
  19. C              NPAPAR = NOMBRE DE POINTS APPARTENANT A UN ELEMENT
  20. C              IEL    = NUMERO GLOBAL DE L'ELEMENT DANS LE MAILLAGE
  21. C              J      = NUMERO DU POINT TRAITE
  22. C              ITRI   = NUMERO DU TETRAEDRE ELEMENTAIRE DANS LE PRISME
  23. C
  24. C***********************************************************************
  25. C
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8 (A-H,O-Z)
  28.       DIMENSION TLI(*)
  29.       DIMENSION XELTET(3,4),IDEPRI(4,3),
  30.      *          NUFACE(4,3),NUARET(6,3),X(3),NFACAR(6,3),NOEARE(6)
  31. C
  32. C
  33.       SEGMENT IZAPAR
  34.            INTEGER IAPAR(4,NPT2)
  35.       ENDSEGMENT
  36. C
  37.       SEGMENT IZTRAV
  38.            REAL*8  COOR(NDIM,NPART)
  39.       ENDSEGMENT
  40.       SEGMENT  IZNOEU
  41.             REAL*8 XELE(IDIM,NOEL)
  42.             INTEGER NOEGLO(NOEL)
  43.       ENDSEGMENT
  44. C
  45. C
  46. C
  47.       DATA IDEPRI/4,6,5,1, 6,5,1,3, 2,3,1,5/
  48.       DATA NUFACE/5,2,0,3, 4,0,0,5, 4,1,0,3/
  49.       DATA NUARET/2,4,7,6,0,0, 6,0,9,0,1,0, 5,3,8,1,0,0/
  50.       DATA NFACAR/5,3,5,4,3,5, 2,5,4,3,1,4, 1,1,3,1,3,4/
  51.       DATA NOEARE/1,3,5,2,4,6/
  52. C
  53.       IDIM=XELE(/1)
  54.       NOEL=XELE(/2)
  55.       INOELO=0
  56. C
  57. C***  DECOUPAGE DU PRISME EN 3 TETRAEDRES ET RECHERCHE DE L'APPARTENANCE
  58. C***  DES POINTS A CHACUN DES TETRAEDRES.
  59. C
  60.       DO 40 I=1,3
  61.       ITRI=I
  62. C
  63. C
  64.       DO 20 K=1,4
  65.       IN=IDEPRI(K,ITRI)
  66.       DO 10 L=1,3
  67.       XELTET(L,K)=XELE(L,IN)
  68.   10  CONTINUE
  69.   20  CONTINUE
  70. C
  71. C
  72. C
  73.       IF(IAPAR(1,J).NE.0) GO TO 9999
  74.       X(1)=COOR(1,J)
  75.       X(2)=COOR(2,J)
  76.       X(3)=COOR(3,J)
  77.       CALL APATET(X,XELTET,IELEM,IFATET,IARTET,INOTET,TLI)
  78.       IF(IELEM.EQ.0) GO TO 40
  79. C
  80. C---  LE POINT APPARTIENT A L'ELEMENT
  81. C
  82.       NPAPAR=NPAPAR+1
  83.       IAPAR(1,J)=IEL
  84. C
  85. C---  APPARTENANCE A UNE FACE DU PRISME
  86. C
  87.       IF(IFATET.EQ.0) GO TO 9999
  88.       IAPAR(2,J)=NUFACE(IFATET,ITRI)
  89. C
  90. C---  APPARTENANCE A UNE ARETE DU PRISME
  91. C
  92.       IF(IARTET.EQ.0) GO TO 9999
  93.       IARPRI=NUARET(IARTET,ITRI)
  94.       IF(IAPAR(2,J).EQ.0.AND.IARTET.NE.0)
  95.      *              IAPAR(2,J)=NFACAR(IARTET,ITRI)
  96.       IAPAR(3,J)=IARPRI
  97. C
  98. C---  APPARTENANCE A UN NOEUD DU PRISME
  99. C
  100.       IF(INOTET.EQ.0) GO TO 9999
  101.       INOELO=IDEPRI(INOTET,ITRI)
  102.       IF(IAPAR(3,J).EQ.0) IAPAR(3,J)=NOEARE(INOELO)
  103.       IARPRI=IAPAR(3,J)
  104.       IF(IAPAR(2,J).EQ.0) IAPAR(2,J)=NFACAR(IARTET,ITRI)
  105.       IAPAR(4,J)=NOEGLO(INOELO)
  106.       GO TO 9999
  107.    40 CONTINUE
  108.  9999 CONTINUE
  109.       RETURN
  110.       END
  111.  
  112.  

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