Esope source files

   1 : C TRJPOR    SOURCE    PV        09/03/13    21:17:12     6328           
   2 :       SUBROUTINE TRJPOR(IZPOR,IZVIT,MELEME)
   3 : C*****************************************************************
   4 : C     TRAITEMENT DE LA POROSITE (OPERATEUR TRAJ)
   5 : C  Divise la vitesse (ou le flux ) par la porosite par element
   6 : C      Controle la coherence des données
   7 : C
   8 : C     IZPOR pointeur du MCHAML contenant la porosité
   9 : C     IZVIT pointeur du segment servant a decrire les vitesses
  10 : C     MELEME pointeur du maillage support( du DOMAINE)
  11 : C *****************************************************************
  12 :       IMPLICIT INTEGER(I-N)
  13 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  14 : C                                                                               
  15 : C                                                                               
  16 :       SEGMENT IZVIT 
  17 :            REAL*8 TEMTRA(NVIPT)
  18 :            INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
  19 :       ENDSEGMENT
  20 : C             IDUN(I) nombre d elements avant le sous maillage I
  21 : C             IPVPT  pointeurs de izvpt pour chaque pas de temps
  22 :       SEGMENT IZVPT
  23 :            INTEGER IPUN1(NBS),IPUMAX
  24 :       ENDSEGMENT
  25 : C
  26 :       SEGMENT IZUN
  27 :            REAL*8 UN(I1,I2,I3)
  28 :       ENDSEGMENT
  29 :       POINTEUR IZUN1.IZUN,IZUN2.IZUN
  30 : -INC SMELEME
  31 : -INC SMCHAML
  32 : -INC CCOPTIO
  33 : C
  34 : C
  35 :       SEGACT IZVIT ,MELEME
  36 :       MCHELM=IZPOR
  37 :       SEGACT MCHELM
  38 :       NBS=IMACHE(/1)
  39 :       NBSOUS=LISOUS(/1)
  40 :       NBS1=NBSOUS
  41 : 
  42 :       IF(NBSOUS.EQ.0)NBS1=1
  43 :       IF(NBS.NE.NBS1)GO TO 95
  44 :       NVIPT=TEMTRA(/1)
  45 :       DO 50 IPT=1,NVIPT
  46 :             IZVPT=IPVPT(IPT)
  47 :             SEGACT IZVPT
  48 :             IPT1=MELEME
  49 :             DO 10 ISOUS=1,NBS
  50 :             IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
  51 :             IF(IPT1.NE.IMACHE(ISOUS))GO TO 95
  52 :             IF(INFCHE(ISOUS,6).NE.2)GO TO 95
  53 :             IZUN=IPUN1(ISOUS)
  54 :             SEGACT IZUN*MOD
  55 :             MCHAML=ICHAML(ISOUS)
  56 :             SEGACT MCHAML
  57 :             N2=IELVAL(/1)
  58 :             IF(N2.NE.1)GO TO 95
  59 :             MELVAL=IELVAL(1)
  60 :             SEGACT MELVAL
  61 :             I1=UN(/1)
  62 :             I2=UN(/2)
  63 :             I3=UN(/3)
  64 :             N1EL=VELCHE(/2)
  65 :             IF(N1EL.NE.I3)GO TO 95
  66 :             DO 30 J3=1,I3
  67 :                 DO 20 J2=1,I2
  68 :                       DO 15 J1=1,I1
  69 :                             UN(J1,J2,J3)=UN(J1,J2,J3)/VELCHE(1,J3)
  70 :    15                 CONTINUE
  71 :    20           CONTINUE
  72 :    30       CONTINUE
  73 :             SEGDES MELVAL,MCHAML,IZUN,IPT1
  74 :    10       CONTINUE
  75 :             SEGDES IZVPT
  76 :    50 CONTINUE
  77 :       SEGDES MCHELM,IZVIT
  78 :       RETURN
  79 :    95 CONTINUE
  80 :       WRITE(IOIMP,*)' POROSITE '
  80 :       CALL ERREUR(609)
  81 :       RETURN
  82 :       END
  83 :  
  84 :  
  85 :  
  86 :  
  87 :  
  88 :