Télécharger la plaquette Cast3M


fr en

Télécharger lieupt.eso

Retour à la liste

Numérotation des lignes : 

lieupt

  1. C LIEUPT    SOURCE    CHAT      05/01/13    01:17:33     5004
  2.       SUBROUTINE LIEUPT(EPSILO,NDIM,ITYG,XREEL,IZSH,JTEST)
  3.  
  4. ****************************************************************************
  5. *** SP 'LIEUPT' : permet de determiner si pt considere est à l'interieur
  6. *** ou à l'exterieur de l'element considere à epsilon pres
  7. ***
  8. *** APPELES 1 = aucun
  9. *** APPELES 2 = 'LIEUP2'
  10. ***
  11. *** E = 'EPSILO' marge relative acceptée position pt % element
  12. ***     'NDIM' dimension de l'espace
  13. ***     'ITYG' entier caracterisant la geometrie de l'element considere
  14. ***     'XREEL' pt considere en coordonnees reelles
  15. ***     'IZSH' segment content coord reelles noeuds, fcts forme et base
  16. ***
  17. *** S = 'JTEST' vaut 1 si pt à l'interieur de l'elemt a epsilon pres, 0 sinon
  18. ***
  19. ***              Auteur Cyril Nou
  20. ****************************************************************************
  21.  
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8 (A-H,O-Z)
  24.       SEGMENT IZSH
  25.           REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  26.       ENDSEGMENT
  27.       DIMENSION PT1(3),PT2(3),PT3(3),PT4(3),XREEL(3)
  28.       DIMENSION ITRIAN(5),ICARRE(6),ICUBE(4,6),IPRISM(4,5),ITETRA(4,4)
  29. ***   donnees ordonnées specifiquement pour chaque type d'element afin de
  30. ***   parcourir les faces dans l'ordre croissant dans les diverses boucles
  31.       DATA ITRIAN/1,2,3,1,2/
  32.       DATA ICARRE/1,2,3,4,1,2/
  33.       DATA ICUBE/1,2,3,5, 5,6,7,1, 1,2,6,3, 2,3,7,1, 3,4,8,1, 1,4,8,2/
  34.       DATA IPRISM/1,2,3,4, 4,5,6,1, 1,2,5,3, 2,3,6,1, 1,3,6,2/
  35.       DATA ITETRA/1,2,4,3, 1,2,3,4, 2,3,4,1, 1,3,4,2/
  36. ***   on postule initialement 'XREEL' appartient à element
  37.       JTEST=1
  38.  
  39. **************
  40. *** CAS 2D ***
  41. **************
  42.  
  43. ***   cas TRI3 (triangles), boucle sur les différentes faces
  44.       IF (ITYG.EQ.4) THEN
  45.          DO 10 I=1,3
  46. ***         recuperation des pts definissant la face + l'origine
  47.             DO 20 J=1,NDIM
  48.                PT1(J)=XYZL(J,ITRIAN(I))
  49.                PT2(J)=XYZL(J,ITRIAN(I+1))
  50.                PT3(J)=XYZL(J,ITRIAN(I+2))
  51.  20         CONTINUE
  52. ***         teste la position de 'XREEL' par rapport à la face
  53.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  54. ***          si 'XREEL' est du mauvais cote de la face
  55.             IF (TEST.LT.(-EPSILO)) THEN
  56. ***            'JTEST'=0 car 'XREEL' est hors du TRI3
  57.                JTEST=0
  58.                RETURN
  59.             ENDIF
  60.  10      CONTINUE
  61. ***   cas QUA4 (quadrangles)
  62.       ELSEIF (ITYG.EQ.8) THEN
  63.          DO 30 I=1,4
  64.             DO 40 J=1,NDIM
  65.                PT1(J)=XYZL(J,ICARRE(I))
  66.                PT2(J)=XYZL(J,ICARRE(I+1))
  67.                PT3(J)=XYZL(J,ICARRE(I+2))
  68.  40         CONTINUE
  69.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  70.             IF (TEST.LT.(-EPSILO)) THEN
  71.                JTEST=0
  72.                RETURN
  73.             ENDIF
  74.  30      CONTINUE
  75.  
  76. **************
  77. *** CAS 3D ***
  78. **************
  79.  
  80. ***   cas CUB8 (cubes)
  81.       ELSEIF (ITYG.EQ.14) THEN
  82.          DO 50 I=1,6
  83.             DO 60 J=1,NDIM
  84.                PT1(J)=XYZL(J,ICUBE(1,I))
  85.                PT2(J)=XYZL(J,ICUBE(2,I))
  86.                PT3(J)=XYZL(J,ICUBE(3,I))
  87.                PT4(J)=XYZL(J,ICUBE(4,I))
  88.  60         CONTINUE
  89.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  90.             IF (TEST.LT.(-EPSILO)) THEN
  91.                JTEST=0
  92.                RETURN
  93.             ENDIF
  94.  50      CONTINUE
  95. ***   cas PRI6 (prismes)
  96.       ELSEIF (ITYG.EQ.16) THEN
  97.          DO 70 I=1,5
  98.             DO 80 J=1,NDIM
  99.                PT1(J)=XYZL(J,IPRISM(1,I))
  100.                PT2(J)=XYZL(J,IPRISM(2,I))
  101.                PT3(J)=XYZL(J,IPRISM(3,I))
  102.                PT4(J)=XYZL(J,IPRISM(4,I))
  103.  80         CONTINUE
  104.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  105.             IF (TEST.LT.(-EPSILO)) THEN
  106.                JTEST=0
  107.                RETURN
  108.             ENDIF
  109.  70      CONTINUE
  110. ***   cas TET4 (tetraedres)
  111.       ELSEIF (ITYG.EQ.23) THEN
  112.          DO 90 I=1,4
  113.             DO 100 J=1,NDIM
  114.                PT1(J)=XYZL(J,ITETRA(1,I))
  115.                PT2(J)=XYZL(J,ITETRA(2,I))
  116.                PT3(J)=XYZL(J,ITETRA(3,I))
  117.                PT4(J)=XYZL(J,ITETRA(4,I))
  118.  100        CONTINUE
  119.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  120.             IF (TEST.LT.(-EPSILO)) THEN
  121.                JTEST=0
  122.                RETURN
  123.             ENDIF
  124.  90      CONTINUE
  125.       ENDIF
  126.       RETURN
  127.       END
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  

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