c@a c@versb C----------------------------------------------------------------------- C CVERS Code_Saturne version 1.3 C ------------------------ C C This file is part of the Code_Saturne Kernel, element of the C Code_Saturne CFD tool. C C Copyright (C) 1998-2007 EDF S.A., France C C contact: saturne-support@edf.fr C C The Code_Saturne Kernel is free software; you can redistribute it C and/or modify it under the terms of the GNU General Public License C as published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C The Code_Saturne Kernel is distributed in the hope that it will be C useful, but WITHOUT ANY WARRANTY; without even the implied warranty C of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public License C along with the Code_Saturne Kernel; if not, write to the C Free Software Foundation, Inc., C 51 Franklin St, Fifth Floor, C Boston, MA 02110-1301 USA C C----------------------------------------------------------------------- c@verse SUBROUTINE CPPHY2 C ***************** C ------------------------------------------------------------- & ( NCELET , NCEL , & RTP , PROPCE ) C ------------------------------------------------------------- C*********************************************************************** C FONCTION : C -------- c@foncb CFONC CFONC CALCUL DES PROPRIETES PHYSIQUES DE LA PHASE DISPERSEE CFONC (CLASSES DE PARTICULES) CFONC VALEURS CELLULES CFONC ---------------- CFONC CFONC FRACTION MASSIQUE DE SOLIDE CFONC ET CLIPPING EVENTUELS CFONC DIAMETRE CFONC MASSE VOLUMIQUE CFONC ET CLIPPING EVENTUELS CFONC c@fonce C ARGUMENTS c@argub CARGU .______________.____._____.______________________________________. CARGU ! NOM !TYPE!MODE ! ROLE ! CARGU !______________!____!_____!______________________________________! CARGU ! NCELET ! E ! -> ! NOMBRE D'ELEMENTS HALO COMPRIS ! CARGU ! NCEL ! E ! -> ! NOMBRE D'ELEMENTS ACTIFS ! CARGU ! RTP ! TR ! -> ! VARIABLES DE CALCUL AU CENTRE DES ! CARGU ! (NCELET,*) ! ! ! CELLULES (INSTANT COURANT) ! CARGU ! PROPCE ! TR ! <-> ! PROPRIETES PHYSIQUES AU CENTRE DES ! CARGU ! (NCELET,*) ! ! ! CELLULES ! CARGU !______________!____!_____!______________________________________! c@argue C c@commb CCOMM COMMONS CCOMM .______________.____._____.______________________________________. CCOMM ! NOM !TYPE!MODE ! ROLE ! CCOMM !______________!____!_____!______________________________________! CCOMM !______________!____!_____!______________________________________! c@comme C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : -> DONNEE, <- RESULTAT, <-> DONNEE MODIFIEE, C - TABLEAU DE TRAVAIL C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C INCLUDE "paramx.h" INCLUDE "numvar.h" INCLUDE "optcal.h" INCLUDE "cstphy.h" INCLUDE "entsor.h" INCLUDE "cstnum.h" INCLUDE "parall.h" INCLUDE "ppppar.h" INCLUDE "ppthch.h" INCLUDE "coincl.h" INCLUDE "cpincl.h" INCLUDE "ppincl.h" C C*********************************************************************** C C ARGUMENTS C INTEGER NCELET , NCEL C DOUBLE PRECISION RTP(NCELET,*) , PROPCE(NCELET,*) C C VARIABLES LOCALES C INTEGER IEL , ICLA , IPCRO2 , IPCDI2 INTEGER N1 , N2 , N3 , N4 , N5 , N6 INTEGER N7 , N8 , IPCX2C INTEGER NBRINT PARAMETER (NBRINT=8) INTEGER INTTMP(NBRINT) DOUBLE PRECISION XCH , DCH , XNP , XCK , DCK , D1S3 DOUBLE PRECISION XASHCL , XUASH DOUBLE PRECISION X2MIN , X2MAX , DCKMIN , DCKMAX DOUBLE PRECISION DCHMIN , DCHMAX , ROMIN , ROMAX , COEDMI C C*********************************************************************** C C======================================================================= C 1. INITIALISATIONS C======================================================================= C D1S3 = 1.D0/3.D0 C C======================================================================= C 2. CALCUL POUR CHAQUE CLASSE C DE LA FRACTION MASSIQUE DE SOLIDE C DU DIAMETRE DU COKE C DE LA MASSE VOLUMIQUE DU CHARBON C======================================================================= C C --> Coefficient relatif au diametre de coke C COEDMI = 1.2D0 C DO ICLA = 1, NCLACP C N1 = 0 N2 = 0 N3 = 0 N4 = 0 N5 = 0 N6 = 0 N7 = 0 N8 = 0 X2MIN = GRAND X2MAX = -GRAND DCHMIN = GRAND DCHMAX = -GRAND DCKMIN = GRAND DCKMAX = -GRAND ROMIN = GRAND ROMAX = -GRAND C DO IEL = 1, NCEL C IPCX2C = IPPROC(IX2(ICLA)) IPCRO2 = IPPROC(IROM2(ICLA)) IPCDI2 = IPPROC(IDIAM2(ICLA)) XCK = RTP(IEL,ISCA(IXCK(ICLA))) XCH = RTP(IEL,ISCA(IXCH(ICLA))) XNP = RTP(IEL,ISCA(INP(ICLA))) XASHCL = XASHCH(ICHCOR(ICLA)) XUASH = XNP*XMP0(ICLA)*(1.D0-XASHCL) C C --- Calcul de la fraction massique de solide C PROPCE(IEL,IPCX2C) = XCH + XCK + XNP*XMASH(ICLA) C C ---- Clipping eventuels pour la fraction massique de solide C IF ( PROPCE(IEL,IPCX2C) .GT. (1.D0+EPSICP) ) THEN N1 = N1 + 1 X2MAX = MAX(PROPCE(IEL,IPCX2C),X2MAX) PROPCE(IEL,IPCX2C) = 1.D0 ELSE IF ( PROPCE(IEL,IPCX2C) .LT. (ZERO-EPSICP) ) THEN N2 = N2 + 1 X2MIN = MIN(PROPCE(IEL,IPCX2C),X2MIN) PROPCE(IEL,IPCX2C) = ZERO ENDIF C C C --- Initialisation C PROPCE(IEL,IPCRO2) = RHO20(ICLA) PROPCE(IEL,IPCDI2) = DIAM20(ICLA) C IF ( XUASH.GT.EPSICP ) THEN C C --- Calcul du diametre du charbon reactif : Dch C DCH = DIAM20(ICLA)*(XCH/XUASH)**D1S3 C C ---- Clipping eventuels pour le diametre du charbon reactif C IF ( DCH .GT. (DIAM20(ICLA)+EPSICP) ) THEN N3 = N3 + 1 DCHMAX = MAX(DCH,DCHMAX) DCH = DIAM20(ICLA) ELSE IF ( DCH .LT. (ZERO-EPSICP) ) THEN N4 = N4 + 1 DCHMIN = MIN(DCH,DCHMIN) DCH = ZERO ENDIF C C --- Calcul du diametre du coke : Dck stocke ds PROPCE(IEL,IPCDI2) C DCK = ( (XCH/RHO20(ICLA)+XCK/RHOCK(ICHCOR(ICLA)))/ & ((1.D0-XASHCL)*PI/6.D0*XNP) )**D1S3 C C ---- Clipping eventuels pour le diametre du coke C IF ( DCK .GT. COEDMI*DIAM20(ICLA) ) THEN N5 = N5 + 1 DCKMAX = MAX(DCK,DCKMAX) DCK = DIAM20(ICLA)*COEDMI ELSE IF ( DCK .LT. (ZERO-EPSICP) ) THEN N6 = N6 + 1 DCKMIN = MIN(DCK,DCKMIN) DCK = ZERO ENDIF PROPCE(IEL,IPCDI2) = DCK C C --- Masse volumique C PROPCE(IEL,IPCRO2) = & ( XASHCL*DIAM20(ICLA)**3*RHO20(ICLA) + & (1.D0-XASHCL)*(DCK**3-DCH**3)*RHOCK(ICHCOR(ICLA)) + & (1.D0-XASHCL)*DCH**3*RHO20(ICLA) ) / & ( XASHCL*DIAM20(ICLA)**3 + & (1.D0-XASHCL)*DCK**3 ) C C ---- Clipping pour la masse volumique C IF ( PROPCE(IEL,IPCRO2) .GT. (RHO20(ICLA)+EPSICP) ) THEN N7 = N7 + 1 ROMAX = MAX(PROPCE(IEL,IPCRO2),ROMAX) PROPCE(IEL,IPCRO2) = RHO20(ICLA) ENDIF IF ( PROPCE(IEL,IPCRO2) .LT. (RHOCK(ICHCOR(ICLA))-EPSICP) ) & THEN N8 = N8 + 1 ROMIN = MIN(PROPCE(IEL,IPCRO2),ROMIN) PROPCE(IEL,IPCRO2) = RHOCK(ICHCOR(ICLA)) ENDIF ENDIF C ENDDO C IF (IRANGP.GE.0) THEN C INTTMP(1) = N1 INTTMP(2) = N2 INTTMP(3) = N3 INTTMP(4) = N4 INTTMP(5) = N5 INTTMP(6) = N6 INTTMP(7) = N7 INTTMP(8) = N8 CALL PARISM (NBRINT,INTTMP) C =========== N1 = INTTMP(1) N2 = INTTMP(2) N3 = INTTMP(3) N4 = INTTMP(4) N5 = INTTMP(5) N6 = INTTMP(6) N7 = INTTMP(7) N8 = INTTMP(8) C CALL PARMAX (X2MAX ) C =========== CALL PARMAX (DCHMAX) C =========== CALL PARMAX (DCKMAX) C =========== CALL PARMAX (ROMAX ) C =========== C CALL PARMIN (X2MIN ) C =========== CALL PARMIN (DCHMIN) C =========== CALL PARMIN (DCKMIN) C =========== CALL PARMIN (ROMIN ) C =========== ENDIF C IF ( N1 .GT. 0 ) THEN WRITE(NFECRA,1001) ICLA, N1, X2MAX ENDIF IF ( N2 .GT. 0 ) THEN WRITE(NFECRA,1002) ICLA, N2, X2MIN ENDIF IF ( N3 .GT. 0 ) THEN WRITE(NFECRA,1003) ICLA, N3, DCHMAX ENDIF IF ( N4 .GT. 0 ) THEN WRITE(NFECRA,1004) ICLA, N4, DCHMIN ENDIF IF ( N5 .GT. 0 ) THEN WRITE(NFECRA,1005) ICLA, N5, DCKMAX ENDIF IF ( N6 .GT. 0 ) THEN WRITE(NFECRA,1006) ICLA, N6, DCKMIN ENDIF IF ( N7 .GT. 0 ) THEN WRITE(NFECRA,1007) ICLA, N7, ROMAX ENDIF IF ( N8 .GT. 0 ) THEN WRITE(NFECRA,1008) ICLA, N8, ROMIN ENDIF C ENDDO C C---- C FORMATS C---- C 1001 FORMAT(/,1X,' CLIPPING EN MAX DE LA FRM SOL. POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Max : ',G15.7) 1002 FORMAT(/,1X,' CLIPPING EN MIN DE LA FRM SOL. POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Max : ',G15.7) 1003 FORMAT(/,1X,' CLIPPING EN MAX DU DIAMETRE CH POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Max : ',G15.7) 1004 FORMAT(/,1X,' CLIPPING EN MIN DU DIAMETRE CH POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Min : ',G15.7) 1005 FORMAT(/,1X,' CLIPPING EN MAX DU DIAMETRE CK POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Max : ',G15.7) 1006 FORMAT(/,1X,' CLIPPING EN MIN DU DIAMETRE CK POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Min : ',G15.7) 1007 FORMAT(/,1X,' CLIPPING EN MAX DE LA MASSE VOL. POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Max : ',G15.7) 1008 FORMAT(/,1X,' CLIPPING EN MIN DE LA MASSE VOL. POUR LA CLASSE ', & I3,/,10X,' Nombre de points : ',I8, & /,10X,' Valeur Min : ',G15.7) & C C C---- C FIN C---- C RETURN END c@z