Télécharger la plaquette Cast3M


fr en

Télécharger trjart.eso

Retour à la liste

Numérotation des lignes : 

trjart

  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.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. C
  23. C
  24.       SEGMENT IZPART
  25.            INTEGER NLEPA(NPART),NUMPA(NPART)
  26.            REAL*8  COORPA(NDIM,NPART)
  27.       ENDSEGMENT
  28.       POINTEUR IZREF.IZPART
  29.       SEGMENT  IZCOU
  30.            REAL*8 DTCO(NEL),COU
  31.       ENDSEGMENT
  32. C
  33.       SEGMENT IZSH
  34.             REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  35.       ENDSEGMENT
  36. C
  37.       SEGMENT IZTRAV
  38.            REAL*8  COOR(NDIM,NPART)
  39.       ENDSEGMENT
  40.       SEGMENT  IZNOEU
  41.             REAL*8 XELE(IDIM,NOEL)
  42.             INTEGER NOEGLO(NOEL)
  43.       ENDSEGMENT
  44.       SEGMENT  IZAPAR
  45.             INTEGER IAPAR(4,NPART)
  46.       ENDSEGMENT
  47.       SEGMENT IZUN
  48.            REAL*8 UN(I1,I2,I3)
  49.       ENDSEGMENT
  50. C
  51. C
  52.       DIMENSION XYREF(3),ZXY(3),UELEM(3)
  53.       DIMENSION TLJ(4)
  54. C
  55. C
  56.       NDIM=COORPA(/1)
  57.       IF(IFORML.EQ.1)THEN
  58.       COUR=0.001D0
  59.       CALL TRJVLO(IZNOEU,IZUN,IZTRAV,ITP,UELEM,IPART,IEL,IZSH)
  60.                 DO 6 ID=1,NDIM
  61.                   COOR(ID,IPART)=COORPA(ID,IPART)+
  62.      *                            UELEM(ID)*DTCO(IEL1)*COUR
  63.    6            CONTINUE
  64.                 CALL INITI(IAPAR(1,IPART),4,0)
  65. C***  PRISMES
  66. C
  67.             IF(ITP.EQ.16)THEN
  68.                 CALL TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  69.      *                                       INOELO,TLJ,ITRI)
  70. C
  71. C***  CUBES
  72. C
  73.             ELSEIF(ITP.EQ.14)THEN
  74.                 CALL TRJCUB(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  75.      *                                               INOELO,TLJ)
  76. C
  77. C***  TETRAEDRE
  78. C
  79.             ELSEIF(ITP.EQ.23)THEN
  80.                 CALL TRJTET(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  81.      *                                               INOELO,TLJ)
  82.           ELSE
  83.               CALL ERREUR(16)
  84.           ENDIF
  85.       ELSEIF(IFORML.EQ.2)THEN
  86. C            FORMULATION HYBRIDE LA PARTICULE IRA DANS L'ELEMENT
  87. C              OU LES DEUX FLUX SONT NEGATIFS
  88.            NAR=IAPAR(3,IPART)
  89.            CALL TRJARF(NAR,NF1,NF2,ITP)
  90. C          write(6,*)' arete face ', nar,nf1 ,nf2,
  91. C    *     UN(1,NF1,IEL),UN(1,NF2,IEL)
  92.            IF((UN(1,NF1,IEL).LE.0.D0).AND.(UN(1,NF2,IEL).LE.0.D0))THEN
  93.             NPAPAR=NPAPAR+1
  94.            ELSE
  95.             CALL INITI(IAPAR(1,IPART),4,0)
  96.            ENDIF
  97.       ENDIF
  98.                 DO 28 ID=1,NDIM
  99.                   COOR(ID,IPART)=COORPA(ID,IPART)
  100.   28            CONTINUE
  101. C
  102.       RETURN
  103.       END
  104.  
  105.  
  106.  

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