C TRJPOR    SOURCE    PV        09/03/13    21:17:12     6328
      SUBROUTINE TRJPOR(IZPOR,IZVIT,MELEME)
C*****************************************************************
C     TRAITEMENT DE LA POROSITE (OPERATEUR TRAJ)
C  Divise la vitesse (ou le flux ) par la porosite par element
C      Controle la coherence des données
C
C     IZPOR pointeur du MCHAML contenant la porosité
C     IZVIT pointeur du segment servant a decrire les vitesses
C     MELEME pointeur du maillage support( du DOMAINE)
C *****************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C
      SEGMENT IZVIT
           REAL*8 TEMTRA(NVIPT)
           INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
      ENDSEGMENT
C             IDUN(I) nombre d elements avant le sous maillage I
C             IPVPT  pointeurs de izvpt pour chaque pas de temps
      SEGMENT IZVPT
           INTEGER IPUN1(NBS),IPUMAX
      ENDSEGMENT
C
      SEGMENT IZUN
           REAL*8 UN(I1,I2,I3)
      ENDSEGMENT
      POINTEUR IZUN1.IZUN,IZUN2.IZUN
-INC SMELEME
-INC SMCHAML

-INC PPARAM
-INC CCOPTIO
C
C
      SEGACT IZVIT ,MELEME
      MCHELM=IZPOR
      SEGACT MCHELM
      NBS=IMACHE(/1)
      NBSOUS=LISOUS(/1)
      NBS1=NBSOUS

      IF(NBSOUS.EQ.0)NBS1=1
      IF(NBS.NE.NBS1)GO TO 95
      NVIPT=TEMTRA(/1)
      DO 50 IPT=1,NVIPT
            IZVPT=IPVPT(IPT)
            SEGACT IZVPT
            IPT1=MELEME
            DO 10 ISOUS=1,NBS
            IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
            IF(IPT1.NE.IMACHE(ISOUS))GO TO 95
            IF(INFCHE(ISOUS,6).NE.2)GO TO 95
            IZUN=IPUN1(ISOUS)
            SEGACT IZUN*MOD
            MCHAML=ICHAML(ISOUS)
            SEGACT MCHAML
            N2=IELVAL(/1)
            IF(N2.NE.1)GO TO 95
            MELVAL=IELVAL(1)
            SEGACT MELVAL
            I1=UN(/1)
            I2=UN(/2)
            I3=UN(/3)
            N1EL=VELCHE(/2)
            IF(N1EL.NE.I3)GO TO 95
            DO 30 J3=1,I3
                DO 20 J2=1,I2
                      DO 15 J1=1,I1
                            UN(J1,J2,J3)=UN(J1,J2,J3)/VELCHE(1,J3)
   15                 CONTINUE
   20           CONTINUE
   30       CONTINUE
            SEGDES MELVAL,MCHAML,IZUN,IPT1
   10       CONTINUE
            SEGDES IZVPT
   50 CONTINUE
      SEGDES MCHELM,IZVIT
      RETURN
   95 CONTINUE
      WRITE(IOIMP,*)' POROSITE '
      CALL ERREUR(609)
      RETURN
      END