Télécharger la plaquette Cast3M


fr en

Télécharger testfa.eso

Retour à la liste

Numérotation des lignes : 

testfa

  1. C TESTFA    SOURCE    CHAT      05/01/13    03:36:24     5004
  2.       SUBROUTINE TESTFA(EPSILO,NDIM,ITYG
  3.      $     ,XREEL,IZSH,JFACE,PT1,PT2,PT3,PT4)
  4.  
  5. *************************************************************************
  6. *** SP 'TESTFA' : permet de tester % element considéré appartenance pt à
  7. *** l'une des faces associées, renvoie alors n° local face ou se trouve pt.
  8. ***
  9. *** APPELES 1 = aucun
  10. *** APPELES 2 = 'LIEUP2'
  11. ***
  12. *** E = 'EPSILO' marge relative acceptée position pt % element
  13. ***     'NDIM' dimension de l'espace
  14. ***     'ITYG' entier caracterisant la geometrie de l'element
  15. ***     'XREEL' coordonnees reelles du pt considéré
  16. ***     'IZSH' segment content coords reelles des noeuds de l'elemt considere
  17. ***
  18. *** S = 'JFACE' n° local face ou se trouve particule, -1 sinon
  19. ***     'PT1', 'PT2', 'PT3', 'PT4' noeuds appartenant à la face
  20. ***
  21. *** Rq : developpee seulement pour ITYPEL = 4,8,14,16 et 23
  22. ***
  23. ***
  24. ***             Auteur Cyril Nou
  25. *************************************************************************
  26.  
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8 (A-H,O-Z)
  29.       SEGMENT IZSH
  30.           REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  31.       ENDSEGMENT
  32.       DIMENSION XREEL(3)
  33.       DIMENSION PT1(3),PT2(3),PT3(3),PT4(3)
  34.       DIMENSION ITRIAN(5),ICARRE(6),ICUBE(4,6),IPRISM(4,5),ITETRA(4,4)
  35. ***   donnees ordonnées specifiquement pour chaque type d'element afin de
  36. ***   parcourir les faces dans l'ordre croissant dans les diverses boucles
  37.       DATA ITRIAN/1,2,3,1,2/
  38.       DATA ICARRE/1,2,3,4,1,2/
  39.       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/
  40.       DATA IPRISM/1,2,3,4, 4,5,6,1, 1,2,5,3, 2,3,6,1, 1,3,6,2/
  41.       DATA ITETRA/1,2,4,3, 1,2,3,4, 2,3,4,1, 1,3,4,2/
  42. ***   on postule initialement non appartenance à face
  43.       JFACE=-1
  44.  
  45. ***   cas TRI3 (triangles), boucle sur les différentes faces
  46.       IF (ITYG.EQ.4) THEN
  47.          DO 10 I=1,3
  48. ***         recuperation des pts definissant la face
  49.             DO 20 J=1,NDIM
  50.                PT1(J)=XYZL(J,ITRIAN(I))
  51.                PT2(J)=XYZL(J,ITRIAN(I+1))
  52.                PT3(J)=XYZL(J,ITRIAN(I+2))
  53.  20         CONTINUE
  54.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  55. ***         'TEST'=0. si appartenance à face considérée
  56.             IF (ABS(TEST).LE.EPSILO) THEN
  57.                JFACE=I
  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 (ABS(TEST).LE.EPSILO) THEN
  71.                JFACE=I
  72.                RETURN
  73.             ENDIF
  74.  30      CONTINUE
  75. ***   cas CUB8 (cubes)
  76.       ELSEIF (ITYG.EQ.14) THEN
  77.          DO 50 I=1,6
  78.             DO 60 J=1,NDIM
  79.                PT1(J)=XYZL(J,ICUBE(1,I))
  80.                PT2(J)=XYZL(J,ICUBE(2,I))
  81.                PT3(J)=XYZL(J,ICUBE(3,I))
  82.                PT4(J)=XYZL(J,ICUBE(4,I))
  83.  60         CONTINUE
  84.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  85.             IF (ABS(TEST).LE.EPSILO) THEN
  86.                JFACE=I
  87.                RETURN
  88.             ENDIF
  89.  50      CONTINUE
  90. ***   cas PRI6 (prismes)
  91.       ELSEIF (ITYG.EQ.16) THEN
  92.          DO 70 I=1,5
  93.             DO 80 J=1,NDIM
  94.                PT1(J)=XYZL(J,IPRISM(1,I))
  95.                PT2(J)=XYZL(J,IPRISM(2,I))
  96.                PT3(J)=XYZL(J,IPRISM(3,I))
  97.                PT4(J)=XYZL(J,IPRISM(4,I))
  98.  80         CONTINUE
  99.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  100.             IF (ABS(TEST).LE.EPSILO) THEN
  101.                JFACE=I
  102.                RETURN
  103.             ENDIF
  104.  70      CONTINUE
  105. ***   cas TET4 (tetraedres)
  106.       ELSEIF (ITYG.EQ.23) THEN
  107.          DO 90 I=1,4
  108.             DO 100 J=1,NDIM
  109.                PT1(J)=XYZL(J,ITETRA(1,I))
  110.                PT2(J)=XYZL(J,ITETRA(2,I))
  111.                PT3(J)=XYZL(J,ITETRA(3,I))
  112.                PT4(J)=XYZL(J,ITETRA(4,I))
  113.  100        CONTINUE
  114.             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  115.             IF (ABS(TEST).LE.EPSILO) THEN
  116.                JFACE=I
  117.                RETURN
  118.             ENDIF
  119.  90     CONTINUE
  120.       ENDIF
  121.  
  122.       RETURN
  123.       END
  124.  
  125.  
  126.  
  127.  

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