Télécharger la plaquette Cast3M


fr en

Télécharger trjqua.eso

Retour à la liste

Numérotation des lignes : 

trjqua

  1. C TRJQUA    SOURCE    PV        22/04/19    16:18:14     11344          
  2.       SUBROUTINE TRJQUA(IZNOEU,IZTRAV,IZAPAR,NPAPAR,J,IEL,INOELO,TLI)
  3. C
  4. C**********************************************************************
  5. C
  6. C   OBJET  : CE SOUS-PROGRAMME CALCULE L'APPARTENANCE DE POINTS A UN
  7. C   -----    ELEMENT QUADRILATERE D'UN MAILLAGE M1.
  8. C       issu de TRIOEF utilise dans le calcul des trajectoires
  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
  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
  23. C              INOELO = NUMERO LOCAL SI LE POINT CHERCHE EST UN NOEUD
  24. C                       DU TRIANGLE CONSIDERE
  25. C              TLI    COORDONNEES BARYCENTRIQUES DU POINT CONSIDERE
  26. C
  27. C***********************************************************************
  28. C
  29.       IMPLICIT INTEGER(I-N)
  30.       IMPLICIT REAL*8 (A-H,O-Z)
  31.       DIMENSION X(3),TLI(*)
  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.       DIMENSION XELTRI(2,6),IDET3(3,2),
  45.      *          IDET67(6,2),NUARET(3,2),NOEAR1(9),NOEAR2(9)
  46. C
  47. C
  48. C
  49.       DATA IDET3/2,3,1, 4,1,3/
  50.       DATA IDET67/3,4,5,9,1,2, 7,8,1,9,5,6/
  51.       DATA NUARET/2,0,1, 4,0,3/
  52.       DATA NOEAR1/4,1,2,3,0,0,0,0,0/
  53.       DATA NOEAR2/4,1,1,2,2,3,3,4,0/
  54. C
  55.       IDIM=XELE(/1)
  56.       NOEL=XELE(/2)
  57.       IF(NOEL.GT.4)GO TO 50
  58. C
  59. C---  CAS QUA4
  60. C
  61. C
  62. C***  DECOUPAGE DU QUA4 EN 2 TRI3 ET RECHERCHE DE L'APPARTENANCE DES
  63. C***  POINTS A CHACUN DES TRI3.
  64. C
  65.       DO 40 I=1,2
  66.       ITRI=I
  67. C
  68. C
  69.       DO 20 K=1,3
  70.       IN=IDET3(K,ITRI)
  71.       DO 10 L=1,2
  72.       XELTRI(L,K)=XELE(L,IN)
  73.   10  CONTINUE
  74.   20  CONTINUE
  75. C
  76. C
  77. C
  78. C     WRITE(6,*)'CALQUA IAPAR ',J,IAPAR(1,J)
  79.       IF(IAPAR(1,J).NE.0) GO TO 9999
  80.       X(1)=COOR(1,J)
  81.       X(2)=COOR(2,J)
  82.       CALL APAT3(X,XELTRI,IELEM,IARTRI,INOTRI,TLI)
  83. C     WRITE(6,*)'CALQUA APAT3',IELEM,IARTRI,INOTRI
  84. C     WRITE(6,*)' IELEM ',IELEM
  85.       IF(IELEM.EQ.0) GO TO 40
  86. C
  87. C---  LE POINT APPARTIENT A L'ELEMENT
  88. C
  89.       NPAPAR=NPAPAR+1
  90.       IAPAR(1,J)=IEL
  91. C
  92. C---  APPARTENANCE A UNE ARETE DU QUA4
  93. C
  94.       IF(IARTRI.EQ.0) GO TO 9999
  95.       IAPAR(3,J)=NUARET(IARTRI,ITRI)
  96. C
  97. C---  APPARTENANCE A UN NOEUD DU QUA4
  98. C
  99.       IF(INOTRI.EQ.0) GO TO 9999
  100.       INOELO=IDET3(INOTRI,ITRI)
  101.       IAPAR(3,J)=NOEAR1(INOELO)
  102.       IAPAR(4,J)=NOEGLO(INOELO)
  103.       GO TO 9999
  104.    40 CONTINUE
  105.       GO TO 9999
  106. C
  107. C---  CAS QUA8-QUA9
  108. C
  109.    50 CONTINUE
  110.       IF(NOEL.NE.8) GO TO 60
  111. C
  112. C***  CALCUL DES COORDONNEES DU POINT MILIEU DE L'ELEMENT POUR GENERER
  113. C***  UN QUA9
  114. C
  115.       XELE(1,9)=0.5D0*(XELE(1,1)+XELE(1,3))
  116.       XELE(2,9)=0.5D0*(XELE(2,3)+XELE(2,5))
  117.    60 CONTINUE
  118. C
  119. C***  DECOUPAGE DU QUA9 EN 2 TRI6 ET RECHERCHE DE L'APPARTENANCE DES
  120. C***  POINTS A CHACUN DES TRI6.
  121. C
  122.       DO 80 I=1,2
  123.       ITRI=I
  124. C
  125. C
  126.       DO 120 K=1,6
  127.       IN=IDET67(K,ITRI)
  128.       DO 110 L=1,2
  129.       XELTRI(L,K)=XELE(L,IN)
  130.  110  CONTINUE
  131.  120  CONTINUE
  132. C
  133. C
  134. C
  135.       IF(IAPAR(1,J).NE.0) GO TO 9999
  136.       X(1)=COOR(1,J)
  137.       X(2)=COOR(2,J)
  138.       CALL APAT67(6,X,XELTRI,IELEM,IARTRI,INOTRI,TLI)
  139.       IF(IELEM.EQ.0) GO TO 80
  140. C
  141. C---  LE POINT APPARTIENT A L'ELEMENT
  142. C
  143.       NPAPAR=NPAPAR+1
  144.       IAPAR(1,J)=IEL
  145. C
  146. C---  APPARTENANCE A UNE ARETE DU QUA9
  147. C
  148.       IF(IARTRI.EQ.0) GO TO 9999
  149.       IAPAR(3,J)=NUARET(IARTRI,ITRI)
  150. C
  151. C---  APPARTENANCE A UN NOEUD DU QUA8 OU QUA9
  152. C
  153.       IF(INOTRI.EQ.0) GO TO 9999
  154.       INOELO=IDET67(INOTRI,ITRI)
  155.       IF(INOELO.EQ.9.AND.NOEL.EQ.8) GO TO 9999
  156.       IAPAR(3,J)=NOEAR2(INOELO)
  157.       IAPAR(4,J)=NOEGLO(INOELO)
  158.       GO TO 9999
  159.    80 CONTINUE
  160. C
  161. C
  162.  9999 CONTINUE
  163.       RETURN
  164.       END
  165.  
  166.  
  167.  

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