Download trjart.eso

Back to the list

   1 : C TRJART    SOURCE    CHAT      05/01/13    03:48:38     5004           
   2 :       SUBROUTINE TRJART(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL,
   3 :      * INOELO,IZPART,IZUN,IZCOU,ITP,IFORML,IZSH)
   4 : C                                                                               
   5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   6 : C                                                                               
   7 : C                  EN 3D
   8 : C     LORSQU UNE PARTICULE EST LACHEE SUR UNE ARETE DU MAILLAGE
   9 : C     GEOMETRIQUE ON DETERMINE SI ELLE EST OU NON DANS L ELEMENT IEL1
  10 : C                                                                               
  11 : C     IZUN VITESSE OU FLUX
  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 IZSH
  32 :             REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  33 :       ENDSEGMENT
  34 : C                                                                               
  35 :       SEGMENT IZTRAV
  36 :            REAL*8  COOR(NDIM,NPART)
  37 :       ENDSEGMENT
  38 :       SEGMENT  IZNOEU 
  39 :             REAL*8 XELE(IDIM,NOEL)  
  40 :             INTEGER NOEGLO(NOEL)
  41 :       ENDSEGMENT
  42 :       SEGMENT  IZAPAR 
  43 :             INTEGER IAPAR(4,NPART)
  44 :       ENDSEGMENT
  45 :       SEGMENT IZUN
  46 :            REAL*8 UN(I1,I2,I3)
  47 :       ENDSEGMENT
  48 : C                                                                               
  49 : C                                                                               
  50 :       DIMENSION XYREF(3),ZXY(3),UELEM(3)                                        
  51 :       DIMENSION TLJ(4)
  52 : C                                                                               
  53 : C                                                                               
  54 :       NDIM=COORPA(/1)
  55 :       IF(IFORML.EQ.1)THEN
  56 :       COUR=0.001D0
  56 :       CALL TRJVLO(IZNOEU,IZUN,IZTRAV,ITP,UELEM,IPART,IEL,IZSH)
  57 :                 DO 6 ID=1,NDIM
  58 :                   COOR(ID,IPART)=COORPA(ID,IPART)+
  59 :      *                            UELEM(ID)*DTCO(IEL1)*COUR
  60 :    6            CONTINUE
  60 :                 CALL INITI(IAPAR(1,IPART),4,0)
  61 : C***  PRISMES                                                                   
  62 : C                                                                               
  63 :             IF(ITP.EQ.16)THEN
  63 :                 CALL TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  64 :      *                                       INOELO,TLJ,ITRI)
  65 : C                                                                               
  66 : C***  CUBES                                                                     
  67 : C                                                                               
  68 :             ELSEIF(ITP.EQ.14)THEN
  68 :                 CALL TRJCUB(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  69 :      *                                               INOELO,TLJ)
  70 : C                                                                               
  71 : C***  TETRAEDRE
  72 : C                                                                               
  73 :             ELSEIF(ITP.EQ.23)THEN
  73 :                 CALL TRJTET(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  74 :      *                                               INOELO,TLJ)
  75 :           ELSE
  75 :               CALL ERREUR(16)
  76 :           ENDIF
  77 :       ELSEIF(IFORML.EQ.2)THEN
  78 : C            FORMULATION HYBRIDE LA PARTICULE IRA DANS L'ELEMENT
  79 : C              OU LES DEUX FLUX SONT NEGATIFS
  80 :            NAR=IAPAR(3,IPART)
  80 :            CALL TRJARF(NAR,NF1,NF2,ITP)
  81 : C          write(6,*)' arete face ', nar,nf1 ,nf2,
  82 : C    *     UN(1,NF1,IEL),UN(1,NF2,IEL)
  83 :            IF((UN(1,NF1,IEL).LE.0.D0).AND.(UN(1,NF2,IEL).LE.0.D0))THEN
  84 :             NPAPAR=NPAPAR+1
  85 :            ELSE
  85 :             CALL INITI(IAPAR(1,IPART),4,0)
  86 :            ENDIF
  87 :       ENDIF
  88 :                 DO 28 ID=1,NDIM
  89 :                   COOR(ID,IPART)=COORPA(ID,IPART)
  90 :   28            CONTINUE
  91 : C                                                                               
  92 :       RETURN
  93 :       END                                                                       
  94 :  
  95 :  

© Cast3M 2003 - All rights reserved.
Disclaimer