Télécharger la plaquette Cast3M


fr en

Télécharger trjpor.eso

Retour à la liste

Numérotation des lignes : 

trjpor

  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.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. C
  36. C
  37.       SEGACT IZVIT ,MELEME
  38.       MCHELM=IZPOR
  39.       SEGACT MCHELM
  40.       NBS=IMACHE(/1)
  41.       NBSOUS=LISOUS(/1)
  42.       NBS1=NBSOUS
  43.  
  44.       IF(NBSOUS.EQ.0)NBS1=1
  45.       IF(NBS.NE.NBS1)GO TO 95
  46.       NVIPT=TEMTRA(/1)
  47.       DO 50 IPT=1,NVIPT
  48.             IZVPT=IPVPT(IPT)
  49.             SEGACT IZVPT
  50.             IPT1=MELEME
  51.             DO 10 ISOUS=1,NBS
  52.             IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
  53.             IF(IPT1.NE.IMACHE(ISOUS))GO TO 95
  54.             IF(INFCHE(ISOUS,6).NE.2)GO TO 95
  55.             IZUN=IPUN1(ISOUS)
  56.             SEGACT IZUN*MOD
  57.             MCHAML=ICHAML(ISOUS)
  58.             SEGACT MCHAML
  59.             N2=IELVAL(/1)
  60.             IF(N2.NE.1)GO TO 95
  61.             MELVAL=IELVAL(1)
  62.             SEGACT MELVAL
  63.             I1=UN(/1)
  64.             I2=UN(/2)
  65.             I3=UN(/3)
  66.             N1EL=VELCHE(/2)
  67.             IF(N1EL.NE.I3)GO TO 95
  68.             DO 30 J3=1,I3
  69.                 DO 20 J2=1,I2
  70.                       DO 15 J1=1,I1
  71.                             UN(J1,J2,J3)=UN(J1,J2,J3)/VELCHE(1,J3)
  72.    15                 CONTINUE
  73.    20           CONTINUE
  74.    30       CONTINUE
  75.             SEGDES MELVAL,MCHAML,IZUN,IPT1
  76.    10       CONTINUE
  77.             SEGDES IZVPT
  78.    50 CONTINUE
  79.       SEGDES MCHELM,IZVIT
  80.       RETURN
  81.    95 CONTINUE
  82.       WRITE(IOIMP,*)' POROSITE '
  83.       CALL ERREUR(609)
  84.       RETURN
  85.       END
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  

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