Download lieupt.eso

Back to the list

   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
  52 :             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  53 : ***          si 'XREEL' est du mauvais cote de la face
  54 :             IF (TEST.LT.(-EPSILO)) THEN
  55 : ***            'JTEST'=0 car 'XREEL' est hors du TRI3
  56 :                JTEST=0
  57 :                RETURN
  58 :             ENDIF
  59 :  10      CONTINUE
  60 : ***   cas QUA4 (quadrangles)
  61 :       ELSEIF (ITYG.EQ.8) THEN
  62 :          DO 30 I=1,4
  63 :             DO 40 J=1,NDIM
  64 :                PT1(J)=XYZL(J,ICARRE(I))
  65 :                PT2(J)=XYZL(J,ICARRE(I+1))
  66 :                PT3(J)=XYZL(J,ICARRE(I+2))
  67 :  40         CONTINUE
  67 :             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  68 :             IF (TEST.LT.(-EPSILO)) THEN
  69 :                JTEST=0
  70 :                RETURN
  71 :             ENDIF
  72 :  30      CONTINUE
  73 : 
  74 : **************
  75 : *** CAS 3D ***
  76 : **************
  77 : 
  78 : ***   cas CUB8 (cubes)
  79 :       ELSEIF (ITYG.EQ.14) THEN
  80 :          DO 50 I=1,6
  81 :             DO 60 J=1,NDIM
  82 :                PT1(J)=XYZL(J,ICUBE(1,I))
  83 :                PT2(J)=XYZL(J,ICUBE(2,I))
  84 :                PT3(J)=XYZL(J,ICUBE(3,I))
  85 :                PT4(J)=XYZL(J,ICUBE(4,I))
  86 :  60         CONTINUE
  86 :             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  87 :             IF (TEST.LT.(-EPSILO)) THEN
  88 :                JTEST=0
  89 :                RETURN
  90 :             ENDIF
  91 :  50      CONTINUE
  92 : ***   cas PRI6 (prismes)
  93 :       ELSEIF (ITYG.EQ.16) THEN
  94 :          DO 70 I=1,5
  95 :             DO 80 J=1,NDIM
  96 :                PT1(J)=XYZL(J,IPRISM(1,I))
  97 :                PT2(J)=XYZL(J,IPRISM(2,I))
  98 :                PT3(J)=XYZL(J,IPRISM(3,I))
  99 :                PT4(J)=XYZL(J,IPRISM(4,I))
 100 :  80         CONTINUE
 100 :             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
 101 :             IF (TEST.LT.(-EPSILO)) THEN
 102 :                JTEST=0
 103 :                RETURN
 104 :             ENDIF
 105 :  70      CONTINUE
 106 : ***   cas TET4 (tetraedres)
 107 :       ELSEIF (ITYG.EQ.23) THEN
 108 :          DO 90 I=1,4
 109 :             DO 100 J=1,NDIM
 110 :                PT1(J)=XYZL(J,ITETRA(1,I))
 111 :                PT2(J)=XYZL(J,ITETRA(2,I))
 112 :                PT3(J)=XYZL(J,ITETRA(3,I))
 113 :                PT4(J)=XYZL(J,ITETRA(4,I))
 114 :  100        CONTINUE
 114 :             CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
 115 :             IF (TEST.LT.(-EPSILO)) THEN
 116 :                JTEST=0
 117 :                RETURN
 118 :             ENDIF
 119 :  90      CONTINUE
 120 :       ENDIF
 121 :       RETURN
 122 :       END
 123 : 
 124 : 
 125 : 
 126 : 
 127 : 
 128 : 
 129 : 
 130 : 
 131 : 
 132 :  
 133 :  

© Cast3M 2003 - All rights reserved.
Disclaimer