Sources Esope | Cast3M

fullery
C FULLERY   SOURCE    CB215821  20/11/25    13:29:39     10792          
      SUBROUTINE FULLERY
C
C--------------------------------------------------------------------
C Evaluation du coefficient de diffusion de la vapeur dans un melange
C de gaz pour une pression et une temperature donnee
C--------------------------------------------------------------------
C
C---------------------------
C Phrase d'appel (GIBIANE) :
C---------------------------
C
C CHP1 = FULLERNC TAB1 ;
C
C------------------------
C Operandes et resultat :
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 melange 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,2),W(NBCELL,2)
         CHARACTER*8 BETA(NBCONS)
      ENDSEGMENT
C
C- Lecture et controles des donnees d'entree,
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 : Temperature
C MCHPO4 : Densité
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
      TYPE = 'CHPOINT '
      CALL ACMO(MTAB2,'RGAS',TYPE,MCHPO4)
      IF (IERR.NE.0) RETURN
      CALL LRCHT(MCHPO4,MPOVA4,TYPS,IGEO1)
      IF (IGEO1.NE.IPT1) THEN
         INDIC  =  1
         NBCOMP = -1
         CALL QUEPOI(MCHPO4,IPT1,INDIC,NBCOMP,NOMTOT)
         IF (IERR.NE.0) RETURN
         CALL LRCHT(MCHPO4,MPOVA4,TYPS,IGEO1)
      ENDIF
C
C- Creation du chpo contenant le coefficient de diffusion
C- de la vapeur dans les incondensables
C
      SEGINI, MCHPOI=MCHPO1
      NC = 1
      SEGINI MSOUPO
      SEGINI, MPOVAL=MPOVA1
      IPCHP(1)  = MSOUPO
      NOCOMP(1) = 'DVAP'
      IGEOC     = IPT1
      IPOVAL    = MPOVAL
      NOHARM(1) = NIFOUR
C
C Creation 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 autorises
      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) = 13.1
      V(2,2) = 6.12
      V(3,2) = 2.67
      V(4,2) = 18.5
      V(5,2) = 16.3
      V(6,2) = 26.9
      V(7,2) = 18.0
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 = 1.D0 / V(II,1)
         A3 = 1.D0 / V(1,1)
         WAB = 2.D3 / (A2 + A3)
         A4  = (V(II,2)**(1.D0/3.D0) + V(1,2)**(1.D0/3.D0))**2.D0
         DO 30 J=1,NBCELL
            GIIJ   = MPOVA3.VPOCHA(J,1) / MPOVA4.VPOCHA(J,1)
            IF (II.NE.1) THEN
             DVIIJ  = (1.D-4 * 0.00143D0) * (MPOVA2.VPOCHA(J,1) ** 1.75)
     &       / ((MPOVA1.VPOCHA(J,1) * 1.D-5)*(WAB ** 0.5D0)*A4)             
             W(J,2) = W(J,2) + GIIJ/DVIIJ
            ELSE
               VPOCHA(J,1) = MPOVA3.VPOCHA(J,1) / MPOVA4.VPOCHA(J,1)
            ENDIF
 30      CONTINUE
         SEGDES MPOVA3
 40   CONTINUE
      SEGDES MTAB3,MPOVA1,MPOVA2,MPOVA4
C
C- Remplissage du chpo contenant le coefficient de diffusion
C- de la vapeur dans les incondensables (loi de Blanc)
C
      DO 50 I=1,NBCELL
         VPOCHA(I,1) = (1.D0 - VPOCHA(I,1)) / W(I,2)
 50   CONTINUE
      SEGDES MCHPOI,MSOUPO,MPOVAL
C
      SEGSUP IWORK
      CALL ECROBJ('CHPOINT ',MCHPOI)
      RETURN
      END