Download trjnoe.eso

Back to the list

   1 : C TRJNOE    SOURCE    CHAT      05/01/13    03:50:16     5004           
   2 :       SUBROUTINE TRJNOE(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL,
   3 :      * INOELO,IZPART,IZUN,IZCOU,ITP,IFORML,XY)
   4 : C                                                                               
   5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   6 : C                                                                               
   7 : C     LORSQU UNE PARTICULE EST LACHEE SUR UN NOEUD DU MAILLAGE
   8 : C     GEOMETRIQUE ON DETERMINE SI ELLE EST OU NON DANS L ELEMENT IEL1
   9 : C                                                                               
  10 : C     IZUN VITESSE OU FLUX
  11 : C     XY COORDONNEES DE REFERENCE DU POINT CONSIDERE
  12 : C                                                                               
  13 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  14 : C                                                                               
  15 : C                                                                               
  16 :       IMPLICIT INTEGER(I-N)
  17 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  18 : C                                                                               
  19 : -INC CCOPTIO
  20 : C                                                                               
  21 : C                                                                               
  22 :       SEGMENT IZPART 
  23 :            INTEGER NLEPA(NPART),NUMPA(NPART)
  24 :            REAL*8  COORPA(NDIM,NPART)
  25 :       ENDSEGMENT
  26 :       POINTEUR IZREF.IZPART
  27 :       SEGMENT  IZCOU 
  28 :            REAL*8 DTCO(NEL),COU
  29 :       ENDSEGMENT
  30 : C                                                                               
  31 :       SEGMENT IZTRAV
  32 :            REAL*8  COOR(NDIM,NPART)
  33 :       ENDSEGMENT
  34 :       SEGMENT  IZNOEU 
  35 :             REAL*8 XELE(IDIM,NOEL)  
  36 :             INTEGER NOEGLO(NOEL)
  37 :       ENDSEGMENT
  38 :       SEGMENT  IZAPAR 
  39 :             INTEGER IAPAR(4,NPART)
  40 :       ENDSEGMENT
  41 :       SEGMENT IZUN
  42 :            REAL*8 UN(I1,I2,I3)
  43 :       ENDSEGMENT
  44 :       SEGMENT HYTRAV
  45 :             REAL*8 XEL(3,NOEL),SHP(6,NOEL),SHY(12,NOEL)
  46 :             REAL*8 ZJAC(NDIM,NDIM)
  47 :       ENDSEGMENT
  48 : C                                                                               
  49 : C                                                                               
  50 :       DIMENSION XY(3),UELEM(3),VECT(3)
  51 :       DIMENSION TLI(4)
  52 : C                                                                               
  53 : C                                                                               
  54 :       NDIM=COORPA(/1)
  55 :       COUR=0.001D0
  56 :       INOEL1= INOELO
  57 :       IF(IFORML.EQ.1)THEN
  58 : C                        FORMULATION ELEMENTS FINIS
  59 :       DO 10 ID=1,NDIM
  60 :       UELEM(ID)=UN(ID,INOELO,IEL)
  61 :    10 CONTINUE
  62 :       ELSEIF(IFORML.EQ.2)THEN
  63 : C                     FORMULATION HYBRIDE ON VA CALCULER LA VITESSE
  64 : C                   REELLE AU NOEUD DU MAILLAGE
  65 : 
  65 :          CALL VHYNOE(UELEM,IZNOEU,IZUN,NDIM,XY,ITP,IEL)
  66 :       ENDIF
  67 :       DO 70 ID=1,NDIM
  68 :       COOR(ID,IPART)=COORPA(ID,IPART)+
  69 :      *              UELEM(ID)*DTCO(IEL1)*COUR
  70 : C     write(6,*)' coor trjnoe ',COOR(ID,IPART),COORPA(ID,IPART),
  71 : C    *              UELEM(ID),DTCO(IEL1),COUR
  72 :   70  CONTINUE
  72 :       CALL INITI(IAPAR(1,IPART),4,0)
  73 : C***  TRIANGLES                                                                 
  74 : C                                                                               
  75 :             IF(ITP.EQ.4.OR.ITP.EQ.6.OR.ITP.EQ.7)THEN
  75 :                 CALL TRJTRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,
  76 :      *                    INOELO,TLI)
  77 : C                                                                               
  78 : C***  QUADRANGLES                                                               
  79 : C                                                                               
  80 :             ELSEIF(ITP.EQ.8.OR.ITP.EQ.11)THEN
  80 :                 CALL TRJQUA(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,
  81 :      *                    INOELO,TLI)
  82 : C***  PRISMES                                                                   
  83 : C                                                                               
  84 :             ELSEIF(ITP.EQ.16)THEN
  84 :                 CALL TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  85 :      *                                  INOELO,TLI,ITRI)
  86 : C                                                                               
  87 : C***  CUBES                                                                     
  88 : C                                                                               
  89 :             ELSEIF(ITP.EQ.14)THEN
  89 :                 CALL TRJCUB(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  90 :      *                                               INOELO,TLI)
  91 : C                                                                               
  92 : C***  TETRAEDRE
  93 : C                                                                               
  94 :             ELSEIF(ITP.EQ.23)THEN
  94 :                 CALL TRJTET(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  95 :      *                                               INOELO,TLI)
  96 :           ELSE
  96 :              CALL ERREUR(16)
  97 :           ENDIF
  98 :       DO 80 ID=1,NDIM
  99 :             COOR(ID,IPART)=COORPA(ID,IPART)
 100 :   80  CONTINUE
 101 :       INOELO=INOEL1
 102 : C                                                                               
 103 :       END                                                                       
 104 :  
 105 :  

© Cast3M 2003 - All rights reserved.
Disclaimer