Sources Esope | Cast3M

todiff
C TODIFF    SOURCE    CB215821  20/11/25    13:41:08     10792          
      SUBROUTINE TODIFF
C
C--------------------------------------------------------------------
C Evaluation du coefficient de diffusion de la vapeur dans un mélange
C de gaz pour une pression et une température donnée
C--------------------------------------------------------------------
C
C---------------------------
C Phrase d'appel (GIBIANE) :
C---------------------------
C
C CHP1 = TODIFF TAB1 ;
C
C------------------------
C Opérandes et résultat :
C------------------------
C
C  TAB1 : TABLE SET contenant l'ensemble des data 0D
C  CHP1 : CHPO de support CELL contenant le coefficient de diffusion
C         de la vapeur dans le mélange de gaz (en m2/s)
C
C--------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      CHARACTER*4  NOMTOT(1)
      CHARACTER*8  TYPE,TYPS,MTYPI,MTYPR,MOT1,MOT2,BETA(7)
      CHARACTER*72 CHARR
      LOGICAL LOGI,LOGR
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
-INC SMTABLE
      SEGMENT IWORK
         REAL*8      V(NBCONS,3),W(NBCELL,2)
         CHARACTER*8 BETA(NBCONS)
      ENDSEGMENT
C
C- Lecture et controles des données d'entrée,
C
C MTAB1 : Table SET
C MTAB2 : Table INCO
C MTAB3 : Table COMPONENT
C MTAB4 : Table GEOINF
C
      CALL LIRTAB('SET',MTAB1,1,IRETOU)
      IF (IERR.NE.0) RETURN
      MTYPI = 'MOT     '
      MTYPR = 'TABLE   '
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'INCO',LOGI,IRETI,
     &                  MTYPR,IVALR,XVALR,CHARR,LOGR,MTAB2)
      IF (IERR.NE.0) RETURN
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'COMPONENT',LOGI,IRETI,
     &                  MTYPR,IVALR,XVALR,CHARR,LOGR,MTAB3)
      IF (IERR.NE.0) RETURN
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'GEOINF',LOGI,IRETI,
     &                  MTYPR,IVALR,XVALR,CHARR,LOGR,MTAB4)
      IF (IERR.NE.0) RETURN
C
C IPT1 : Maillage POI1 des CELLs
C
      TYPE = 'MAILLAGE'
      CALL ACMO(MTAB4,'CELL',TYPE,IPT1)
      IF (IERR.NE.0) RETURN
C
C MCHPO1 : Pression
C MCHPO2 : Température
C
      TYPE = 'CHPOINT '
      TYPS = '        '
      CALL ACMO(MTAB2,'PT',TYPE,MCHPO1)
      CALL LRCHT(MCHPO1,MPOVA1,TYPS,IGEO1)
      IF (IERR.NE.0) RETURN
      IF (IGEO1.NE.IPT1) THEN
         INDIC  =  1
         NBCOMP = -1
         CALL QUEPOI(MCHPO1,IPT1,INDIC,NBCOMP,NOMTOT)
         IF (IERR.NE.0) RETURN
         CALL LRCHT(MCHPO1,MPOVA1,TYPS,IGEO1)
      ENDIF
C
      TYPE = 'CHPOINT '
      CALL ACMO(MTAB2,'TGAS',TYPE,MCHPO2)
      IF (IERR.NE.0) RETURN
      CALL LRCHT(MCHPO2,MPOVA2,TYPS,IGEO1)
      IF (IGEO1.NE.IPT1) THEN
         INDIC  =  1
         NBCOMP = -1
         CALL QUEPOI(MCHPO2,IPT1,INDIC,NBCOMP,NOMTOT)
         IF (IERR.NE.0) RETURN
         CALL LRCHT(MCHPO2,MPOVA2,TYPS,IGEO1)
      ENDIF
C
C Création du segment IWORK
C Ordre des constituants : H2O, H2, He, N2, O2, CO2, CO
C
      SEGACT IPT1
      NBCELL = IPT1.NUM(/2)
      SEGDES IPT1
      NBCONS = 7
      SEGINI IWORK
C
C- Liste des constituants autorisés
      BETA(1) = 'H2O     '
      BETA(2) = 'H2      '
      BETA(3) = 'HE      '
      BETA(4) = 'N2      '
      BETA(5) = 'O2      '
      BETA(6) = 'CO2     '
      BETA(7) = 'CO      '
C
C- Masse molaire (en kg/mol)
      V(1,1) = 0.018D0
      V(2,1) = 0.002D0
      V(3,1) = 0.004D0
      V(4,1) = 0.028D0
      V(5,1) = 0.032D0
      V(6,1) = 0.044D0
      V(7,1) = 0.028D0
C
C- Coefficient intervenant dans l'expression de la loi de diffusion
C- de la vapeur dans le constituant de rang i lorsqu'il est seul
      V(1,2) = 0.277D-4
      V(2,2) = 0.780D-4
      V(3,2) = 0.730D-4
      V(4,2) = 0.227D-4
      V(5,2) = 0.240D-4
      V(6,2) = 0.155D-4
      V(7,2) = 0.220D-4
C
C- Puissance intervenant dans l'expression de la loi de diffusion
C- de la vapeur dans le constituant de rang i lorsqu'il est seul
      V(1,3) = 0.00D0
      V(2,3) = 1.75D0
      V(3,3) = 1.75D0
      V(4,3) = 1.75D0
      V(5,3) = 1.71D0
      V(6,3) = 1.75D0
      V(7,3) = 1.75D0
C
      SEGACT MTAB3
      IDIM1 = MTAB3.MLOTAB
      DO 40 I=1,IDIM1
         CALL ACEM(MTAB3,I,MOT1)
         MOT2 = 'R' // MOT1(1:7)
         TYPE = 'CHPOINT '
         CALL ACMO(MTAB2,MOT2,TYPE,MCHPO3)
         IF (IERR.NE.0) RETURN
         II = 0
         DO 10 K=1,NBCONS
            IF (BETA(K).EQ.MOT1) THEN
               II = K
               GOTO 20
            ENDIF
 10      CONTINUE
C        Le mot %m1:4 n'est pas un nom de composante reconnu
         MOTERR(1:4) = MOT1(1:4)
         CALL ERREUR(197)
         RETURN
 20      CONTINUE
         CALL LRCHT(MCHPO3,MPOVA3,TYPS,IGEO1)
         IF (IGEO1.NE.IPT1) THEN
            INDIC  =  1
            NBCOMP = -1
            CALL QUEPOI(MCHPO3,IPT1,INDIC,NBCOMP,NOMTOT)
            IF (IERR.NE.0) RETURN
            CALL LRCHT(MCHPO3,MPOVA3,TYPS,IGEO1)
         ENDIF
         A1 = V(II,1)
         A2 = V(II,2)
         A3 = V(II,3)
         DO 30 J=1,NBCELL
            DVIIJ  = A2 / (MPOVA1.VPOCHA(J,1) * 1.D-5)
     &             * ((MPOVA2.VPOCHA(J,1) / 273.15D0) ** A3)
            GIIJ   = MPOVA3.VPOCHA(J,1) / A1
            W(J,1) = W(J,1) + GIIJ
            W(J,2) = W(J,2) + GIIJ/DVIIJ
 30      CONTINUE
         SEGDES MPOVA3
 40   CONTINUE
      SEGDES MTAB3,MPOVA1,MPOVA2
C
C- Création/remplissage du chpo contenant le coefficient de diffusion
C- de la vapeur dans le mélange de gaz
C
      SEGINI, MCHPOI=MCHPO1
      NC = 1
      SEGINI MSOUPO
      SEGINI, MPOVAL=MPOVA1
      IPCHP(1)  = MSOUPO
      NOCOMP(1) = 'DVAP'
      IGEOC     = IPT1
      IPOVAL    = MPOVAL
      NOHARM(1) = NIFOUR
      DO 50 I=1,NBCELL
         VPOCHA(I,1) = W(I,1) / W(I,2)
 50   CONTINUE
      SEGDES MCHPOI,MSOUPO,MPOVAL
C
      SEGSUP IWORK
      CALL ECROBJ('CHPOINT ',MCHPOI)
      RETURN
      END