Télécharger la plaquette Cast3M


fr en

Télécharger trjapf.eso

Retour à la liste

Numérotation des lignes : 

trjapf

  1. C TRJAPF    SOURCE    CHAT      05/01/13    03:48:32     5004
  2.       SUBROUTINE TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL,
  3.      * INOELO,IZPART,IZUN,IZCOU,ITP,IFORML,IZSH)
  4. C
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C     LORSQU UNE PARTICULE EST LACHEE SUR UNE FACE 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
  12. C   IAPAR(1,IPART)  NO DE L ELEMENT AUQUEL APPARTIENT LA PARTICULE
  13. C   IAPAR(2,IPART)  NO DE LA FACE 3D A LAQUELLE APPARTIENT LA PARTICULE
  14. C   IAPAR(3,IPART)  NO DE L ARETE A LAQUELLE APPARTIENT LA PARTICULE
  15. C   IAPAR(4,IPART)  NO DU NOEUD AUQUEL APPARTIENT LA PARTICULE
  16. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  17. C
  18. C
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8 (A-H,O-Z)
  21. C
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. C
  26. C
  27.       SEGMENT IZPART
  28.            INTEGER NLEPA(NPART),NUMPA(NPART)
  29.            REAL*8  COORPA(NDIM,NPART)
  30.       ENDSEGMENT
  31.       SEGMENT  IZCOU
  32.            REAL*8 DTCO(NEL),COU
  33.       ENDSEGMENT
  34. C
  35.       SEGMENT IZSH
  36.             REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  37.       ENDSEGMENT
  38. C
  39.       SEGMENT IZTRAV
  40.            REAL*8  COOR(NDIM,NPART)
  41.       ENDSEGMENT
  42.       SEGMENT  IZNOEU
  43.             REAL*8 XELE(IDIM,NOEL)
  44.             INTEGER NOEGLO(NOEL)
  45.       ENDSEGMENT
  46.       SEGMENT  IZAPAR
  47.             INTEGER IAPAR(4,NPART)
  48.       ENDSEGMENT
  49.       SEGMENT IZUN
  50.            REAL*8 UN(I1,I2,I3)
  51.       ENDSEGMENT
  52. C
  53. C
  54.       DIMENSION XYREF(3),ZXY(3),UELEM(3)
  55.       DIMENSION TLJ(4)
  56. C
  57. C
  58.       NDIM=COORPA(/1)
  59.       IF(IFORML.EQ.1)THEN
  60. C  FORMULATION ELEMENTS FINIS ON DEPLACE UN PEUT LA PARTICULE
  61. C  POUR VOIR SI RESTERA DANS CET ELEMENT
  62.            COUR=0.001D0
  63.            CALL TRJVLO(IZNOEU,IZUN,IZTRAV,ITP,UELEM,IPART,IEL,IZSH)
  64.            DO 6 ID=1,NDIM
  65.            COOR(ID,IPART)=COORPA(ID,IPART)+
  66.      *                            UELEM(ID)*DTCO(IEL1)*COUR
  67. C        write(6,*)' coor', COOR(ID,IPART),COORPA(ID,IPART),
  68. C    *                            UELEM(ID),DTCO(IEL1),COUR
  69.    6       CONTINUE
  70.            CALL INITI(IAPAR(1,IPART),4,0)
  71. C***  TRIANGLES
  72. C
  73.             IF(ITP.EQ.4.OR.ITP.EQ.6.OR.ITP.EQ.7)THEN
  74.                 CALL TRJTRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,
  75.      *                    INOELO,TLJ)
  76. C
  77. C***  QUADRANGLES
  78. C
  79.             ELSEIF(ITP.EQ.8.OR.ITP.EQ.11)THEN
  80.                 CALL TRJQUA(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,
  81.      *                    INOELO,TLJ)
  82. C***  PRISMES
  83. C
  84.             ELSEIF(ITP.EQ.16)THEN
  85.                 CALL TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  86.      *                                   INOELO,TLJ,ITRI)
  87. C
  88. C***  CUBES
  89. C
  90.             ELSEIF(ITP.EQ.14)THEN
  91.                 CALL TRJCUB(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  92.      *                                               INOELO,TLJ)
  93. C
  94. C***  TETRAEDRE
  95. C
  96.             ELSEIF(ITP.EQ.23)THEN
  97.                 CALL TRJTET(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
  98.      *                                               INOELO,TLJ)
  99.           ELSE
  100.              CALL ERREUR(16)
  101.           ENDIF
  102. C
  103.       ELSEIF(IFORML.EQ.2)THEN
  104. C    FORMULATION HYBRIDE LA PARTICULE SERA DANS CET ELEMENT
  105. C              SI LE FLUX EST NEGATIF POUR LA FACE CONSIDEREE
  106.            NF=IAPAR(3,IPART)
  107.            IF(NDIM.EQ.3)NF=IAPAR(2,IPART)
  108.            IF(UN(1,NF,IEL).LE.0)THEN
  109.                  NPAPAR=NPAPAR+1
  110.            ELSE
  111.                 CALL INITI(IAPAR(1,IPART),4,0)
  112.            ENDIF
  113. C     write(6,*)'trjapf ',iel,nf,UN(1,NF,IEL),coorpa(1,ipart),
  114. C    *  coorpa(2,ipart)
  115.       ENDIF
  116.       DO 28 ID=1,NDIM
  117.       COOR(ID,IPART)=COORPA(ID,IPART)
  118.   28  CONTINUE
  119.       RETURN
  120.       END
  121.  
  122.  
  123.  

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