C TRJAPF    SOURCE    CHAT      05/01/13    03:48:32     5004           
      SUBROUTINE TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL,
     * INOELO,IZPART,IZUN,IZCOU,ITP,IFORML,IZSH)
C                                                                               
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                               
C     LORSQU UNE PARTICULE EST LACHEE SUR UNE FACE DU MAILLAGE
C     GEOMETRIQUE ON DETERMINE SI ELLE EST OU NON DANS L ELEMENT IEL1
C                                                                               
C     IZUN VITESSE OU FLUX
C                                                                               
C   IAPAR(1,IPART)  NO DE L ELEMENT AUQUEL APPARTIENT LA PARTICULE
C   IAPAR(2,IPART)  NO DE LA FACE 3D A LAQUELLE APPARTIENT LA PARTICULE
C   IAPAR(3,IPART)  NO DE L ARETE A LAQUELLE APPARTIENT LA PARTICULE
C   IAPAR(4,IPART)  NO DU NOEUD AUQUEL APPARTIENT LA PARTICULE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                               
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
C                                                                               
-INC CCOPTIO
C                                                                               
C                                                                               
      SEGMENT IZPART 
           INTEGER NLEPA(NPART),NUMPA(NPART)
           REAL*8  COORPA(NDIM,NPART)
      ENDSEGMENT
      SEGMENT  IZCOU 
           REAL*8 DTCO(NEL),COU
      ENDSEGMENT
C                                                                               
      SEGMENT IZSH
            REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
      ENDSEGMENT
C                                                                               
      SEGMENT IZTRAV
           REAL*8  COOR(NDIM,NPART)
      ENDSEGMENT
      SEGMENT  IZNOEU 
            REAL*8 XELE(IDIM,NOEL)  
            INTEGER NOEGLO(NOEL)
      ENDSEGMENT
      SEGMENT  IZAPAR 
            INTEGER IAPAR(4,NPART)
      ENDSEGMENT
      SEGMENT IZUN
           REAL*8 UN(I1,I2,I3)
      ENDSEGMENT
C                                                                               
C                                                                               
      DIMENSION XYREF(3),ZXY(3),UELEM(3)                                        
      DIMENSION TLJ(4)
C                                                                               
C                                                                               
      NDIM=COORPA(/1)
      IF(IFORML.EQ.1)THEN
C  FORMULATION ELEMENTS FINIS ON DEPLACE UN PEUT LA PARTICULE
C  POUR VOIR SI RESTERA DANS CET ELEMENT
           COUR=0.001D0
           CALL TRJVLO(IZNOEU,IZUN,IZTRAV,ITP,UELEM,IPART,IEL,IZSH)
           DO 6 ID=1,NDIM
           COOR(ID,IPART)=COORPA(ID,IPART)+
     *                            UELEM(ID)*DTCO(IEL1)*COUR
C        write(6,*)' coor', COOR(ID,IPART),COORPA(ID,IPART),
C    *                            UELEM(ID),DTCO(IEL1),COUR
   6       CONTINUE
           CALL INITI(IAPAR(1,IPART),4,0)
C***  TRIANGLES                                                                 
C                                                                               
            IF(ITP.EQ.4.OR.ITP.EQ.6.OR.ITP.EQ.7)THEN
                CALL TRJTRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,
     *                    INOELO,TLJ)
C                                                                               
C***  QUADRANGLES                                                               
C                                                                               
            ELSEIF(ITP.EQ.8.OR.ITP.EQ.11)THEN
                CALL TRJQUA(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,
     *                    INOELO,TLJ)
C***  PRISMES                                                                   
C                                                                               
            ELSEIF(ITP.EQ.16)THEN
                CALL TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
     *                                   INOELO,TLJ,ITRI)
C                                                                               
C***  CUBES                                                                     
C                                                                               
            ELSEIF(ITP.EQ.14)THEN
                CALL TRJCUB(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
     *                                               INOELO,TLJ)
C                                                                               
C***  TETRAEDRE
C                                                                               
            ELSEIF(ITP.EQ.23)THEN
                CALL TRJTET(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,
     *                                               INOELO,TLJ)
          ELSE
             CALL ERREUR(16)
          ENDIF
C                                                                               
      ELSEIF(IFORML.EQ.2)THEN
C    FORMULATION HYBRIDE LA PARTICULE SERA DANS CET ELEMENT
C              SI LE FLUX EST NEGATIF POUR LA FACE CONSIDEREE
           NF=IAPAR(3,IPART)
           IF(NDIM.EQ.3)NF=IAPAR(2,IPART)
           IF(UN(1,NF,IEL).LE.0)THEN
                 NPAPAR=NPAPAR+1
           ELSE
                CALL INITI(IAPAR(1,IPART),4,0)
           ENDIF
C     write(6,*)'trjapf ',iel,nf,UN(1,NF,IEL),coorpa(1,ipart),
C    *  coorpa(2,ipart)
      ENDIF
      DO 28 ID=1,NDIM
      COOR(ID,IPART)=COORPA(ID,IPART)
  28  CONTINUE
      RETURN
      END