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 CPTSVC C ***************** C ------------------------------------------------------------- & ( IDBIA0 , IDBRA0 , & NDIM , NCELET , NCEL , NFAC , NFABOR , NFML , NPRFML , & NNOD , LNDFAC , LNDFBR , NCELBR , & NVAR , NSCAL , NPHAS , NCEPDP , NCKPDP , NCESMP , & NIDEVE , NRDEVE , NITUSE , NRTUSE , ISCAL , ISCALA , & IFACEL , IFABOR , IFMFBR , IFMCEL , IPRFML , ITYPFB , & IPNFAC , NODFAC , IPNFBR , NODFBR , ICEPDC , ICETSM , ITYPSM , & IDEVEL , ITUSER , IA , & XYZCEN , SURFAC , SURFBO , CDGFAC , CDGFBO , XYZNOD , VOLUME , & DT , RTPA , RTP , PROPCE , PROPFA , PROPFB , & COEFA , COEFB , & SMBRS , ROVSDT , & WFB , & W1 , W2 , W3 , W4 , W5 , & W6 , W7 , W8 , & RDEVEL , RTUSER , RA ) C ------------------------------------------------------------- C*********************************************************************** C FONCTION : C ---------- c@foncb CFONC CFONC ROUTINE PHYSIQUE PARTICULIERE : FLAMME CHARBON PULVERISE CFONC TERMES SOURCES DE PRODUCTION ET DE DISSIPATION POUR CFONC LA VARIANCE (BILANS EXPLICITE ET IMPLICITE) CFONC c@fonce C----------------------------------------------------------------------- c@argub CARGU ARGUMENTS CARGU .______________.____._____.______________________________________. CARGU ! NOM !TYPE!MODE ! ROLE ! CARGU !______________!____!_____!______________________________________! CARGU ! IDBIA0 ! E ! -> ! NUMERO DE LA 1ERE CASE LIBRE DANS IA ! CARGU ! IDBRA0 ! E ! -> ! NUMERO DE LA 1ERE CASE LIBRE DANS RA ! CARGU ! NDIM ! E ! -> ! DIMENSION DE L'ESPACE ! CARGU ! NCELET ! E ! -> ! NOMBRE D'ELEMENTS HALO COMPRIS ! CARGU ! NCEL ! E ! -> ! NOMBRE D'ELEMENTS ACTIFS ! CARGU ! NFAC ! E ! -> ! NOMBRE DE FACES INTERNES ! CARGU ! NFABOR ! E ! -> ! NOMBRE DE FACES DE BORD ! CARGU ! NFML ! E ! -> ! NOMBRE DE FAMILLES D ENTITES ! CARGU ! NPRFML ! E ! -> ! NOMBRE DE PROPRIETESE DES FAMILLES ! CARGU ! NNOD ! E ! -> ! NOMBRE DE SOMMETS ! CARGU ! LNDFAC ! E ! -> ! LONGUEUR DU TABLEAU NODFAC (OPTIONNEL! CARGU ! LNDFBR ! E ! -> ! LONGUEUR DU TABLEAU NODFBR (OPTIONNEL! CARGU ! NCELBR ! E ! -> ! NOMBRE D'ELEMENTS AYANT AU MOINS UNE ! CARGU ! ! ! ! FACE DE BORD ! CARGU ! NVAR ! E ! -> ! NOMBRE TOTAL DE VARIABLES ! CARGU ! NSCAL ! E ! -> ! NOMBRE TOTAL DE SCALAIRES ! CARGU ! NPHAS ! E ! -> ! NOMBRE DE PHASES ! CARGU ! NCEPDP ! E ! -> ! NOMBRE DE CELLULES AVEC PDC ! CARGU ! NCKPDP ! E ! -> ! NBR DE COEF DU TENSEUR DE PDC (3 OU 6! CARGU ! NCESMP ! E ! -> ! NOMBRE DE CELLULES A SOURCE DE MASSE ! CARGU ! NIDEVE NRDEVE! E ! -> ! LONGUEUR DE IDEVEL RDEVEL ! CARGU ! NITUSE NRTUSE! E ! -> ! LONGUEUR DE ITUSER RTUSER ! CARGU ! ISCAL ! E ! -> ! NUMERO DU SCALAIRE ! CARGU ! ISCALA ! E ! -> ! NUMERO DU SCALAIRE ASSOCIE ! CARGU ! IFACEL ! TE ! -> ! ELEMENTS VOISINS D'UNE FACE INTERNE ! CARGU ! (2, NFAC) ! ! ! ! CARGU ! IFABOR ! TE ! -> ! ELEMENT VOISIN D'UNE FACE DE BORD ! CARGU ! (NFABOR) ! ! ! ! CARGU ! IFMFBR ! TE ! -> ! NUMERO DE FAMILLE D'UNE FACE DE BORD ! CARGU ! (NFABOR) ! ! ! ! CARGU ! IFMCEL ! TE ! -> ! NUMERO DE FAMILLE D'UNE CELLULE ! CARGU ! (NCELET) ! ! ! ! CARGU ! IPRFML ! TE ! -> ! PROPRIETES D'UNE FAMILLE ! CARGU ! ITYPFB(NFABOR! TE ! -> ! TYPE DES FACES DE BORD ! CARGU ! NPHAS )! ! ! ! CARGU ! NFML ,NPRFML! ! ! ! CARGU ! IPNFAC ! TE ! -> ! POSITION DU PREMIER NOEUD DE CHAQUE ! CARGU ! (LNDFAC) ! ! ! FACE INTERNE DANS NODFAC (OPTIONNEL)! CARGU ! NODFAC ! TE ! -> ! CONNECTIVITE FACES INTERNES/NOEUDS ! CARGU ! (NFAC+1) ! ! ! (OPTIONNEL) ! CARGU ! IPNFBR ! TE ! -> ! POSITION DU PREMIER NOEUD DE CHAQUE ! CARGU ! (LNDFBR) ! ! ! FACE DE BORD DANS NODFBR (OPTIONNEL)! CARGU ! NODFBR ! TE ! -> ! CONNECTIVITE FACES DE BORD/NOEUDS ! CARGU ! (NFABOR+1) ! ! ! (OPTIONNEL) ! CARGU ! ICEPDC(NCELET! TE ! -> ! NUMERO DES NCEPDP CELLULES AVEC PDC ! CARGU ! ICETSM(NCESMP! TE ! -> ! NUMERO DES CELLULES A SOURCE DE MASSE! CARGU ! ITYPSM ! TE ! -> ! TYPE DE SOURCE DE MASSE POUR LES ! CARGU ! (NCESMP,NVAR)! ! ! VARIABLES (cf. USTSMA) ! CARGU ! IDEVEL(NIDEVE! TE ! <-> ! TAB ENTIER COMPLEMENTAIRE DEVELOPEMT ! CARGU ! ITUSER(NITUSE! TE ! <-> ! TAB ENTIER COMPLEMENTAIRE UTILISATEUR! CARGU ! IA(*) ! TR ! - ! MACRO TABLEAU ENTIER ! CARGU ! XYZCEN ! TR ! -> ! POINT ASSOCIES AUX VOLUMES DE CONTROL! CARGU ! (NDIM,NCELET ! ! ! ! CARGU ! SURFAC ! TR ! -> ! VECTEUR SURFACE DES FACES INTERNES ! CARGU ! (NDIM,NFAC) ! ! ! ! CARGU ! SURFBO ! TR ! -> ! VECTEUR SURFACE DES FACES DE BORD ! CARGU ! (NDIM,NFABOR)! ! ! ! CARGU ! CDGFAC ! TR ! -> ! CENTRE DE GRAVITE DES FACES INTERNES ! CARGU ! (NDIM,NFAC) ! ! ! ! CARGU ! CDGFBO ! TR ! -> ! CENTRE DE GRAVITE DES FACES DE BORD ! CARGU ! (NDIM,NFABOR)! ! ! ! CARGU ! XYZNOD ! TR ! -> ! COORDONNES DES NOEUDS (OPTIONNEL) ! CARGU ! (NDIM,NNOD) ! ! ! ! CARGU ! VOLUME ! TR ! -> ! VOLUME D'UN DES NCELET ELEMENTS ! CARGU ! (NCELET ! ! ! ! CARGU ! DT(NCELET) ! TR ! -> ! PAS DE TEMPS ! CARGU ! RTP, RTPA ! TR ! -> ! VARIABLES DE CALCUL AU CENTRE DES ! CARGU ! (NCELET,*) ! ! ! CELLULES (INSTANT COURANT OU PREC)! CARGU ! PROPCE ! TR ! -> ! PROPRIETES PHYSIQUES AU CENTRE DES ! CARGU ! (NCELET,*) ! ! ! CELLULES ! CARGU ! PROPFA ! TR ! -> ! PROPRIETES PHYSIQUES AU CENTRE DES ! CARGU ! (NFAC,*) ! ! ! FACES INTERNES ! CARGU ! PROPFB ! TR ! -> ! PROPRIETES PHYSIQUES AU CENTRE DES ! CARGU ! (NFABOR,*) ! ! ! FACES DE BORD ! CARGU ! COEFA, COEFB ! TR ! -> ! CONDITIONS AUX LIMITES AUX ! CARGU ! (NFABOR,*) ! ! ! FACES DE BORD ! CARGU ! SMBRS(NCELET)! TR ! <- ! SECOND MEMBRE EXPLICITE ! CARGU ! ROVSDT(NCELET! TR ! <- ! PARTIE DIAGONALE IMPLICITE ! CARGU ! WFB(NFABOR) ! TR ! - ! TABLEAU DE TRAVAIL FACES DE BORD ! CARGU ! W1..8(NCELET)! TR ! - ! TABLEAU DE TRAVAIL CELLULES ! CARGU ! RDEVEL(NRDEVE! TR ! <-> ! TAB REEL COMPLEMENTAIRE DEVELOPEMT ! CARGU ! RTUSER(NRTUSE! TR ! <-> ! TAB REEL COMPLEMENTAIRE UTILISATEUR ! CARGU ! RA(*) ! TR ! - ! MACRO TABLEAU REEL ! 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*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C INCLUDE "paramx.h" INCLUDE "numvar.h" INCLUDE "entsor.h" INCLUDE "optcal.h" INCLUDE "cstphy.h" INCLUDE "cstnum.h" INCLUDE "parall.h" INCLUDE "period.h" INCLUDE "ppppar.h" INCLUDE "ppthch.h" INCLUDE "coincl.h" INCLUDE "cpincl.h" INCLUDE "ppincl.h" C C*********************************************************************** C C ARGUMENTS C INTEGER IDBIA0 , IDBRA0 INTEGER NDIM , NCELET , NCEL , NFAC , NFABOR INTEGER NFML , NPRFML INTEGER NNOD , LNDFAC , LNDFBR , NCELBR INTEGER NVAR , NSCAL , NPHAS INTEGER NCEPDP , NCKPDP , NCESMP INTEGER NIDEVE , NRDEVE , NITUSE , NRTUSE INTEGER ISCAL , ISCALA C INTEGER IFACEL(2,NFAC) , IFABOR(NFABOR) INTEGER IFMFBR(NFABOR) , IFMCEL(NCELET) INTEGER IPRFML(NFML,NPRFML) , ITYPFB(NFABOR,NPHAS) INTEGER IPNFAC(NFAC+1), NODFAC(LNDFAC) INTEGER IPNFBR(NFABOR+1), NODFBR(LNDFBR) INTEGER ICEPDC(NCEPDP) INTEGER ICETSM(NCESMP), ITYPSM(NCESMP,NVAR) INTEGER IDEVEL(NIDEVE) INTEGER ITUSER(NITUSE), IA(*) C DOUBLE PRECISION XYZCEN(NDIM,NCELET) DOUBLE PRECISION SURFAC(NDIM,NFAC), SURFBO(NDIM,NFABOR) DOUBLE PRECISION CDGFAC(NDIM,NFAC), CDGFBO(NDIM,NFABOR) DOUBLE PRECISION XYZNOD(NDIM,NNOD), VOLUME(NCELET) DOUBLE PRECISION DT(NCELET), RTP(NCELET,*), RTPA(NCELET,*) DOUBLE PRECISION PROPCE(NCELET,*) DOUBLE PRECISION PROPFA(NFAC,*), PROPFB(NFABOR,*) DOUBLE PRECISION COEFA(NFABOR,*), COEFB(NFABOR,*) DOUBLE PRECISION SMBRS(NCELET), ROVSDT(NCELET) DOUBLE PRECISION WFB(NFABOR) DOUBLE PRECISION W1(NCELET), W2(NCELET), W3(NCELET) DOUBLE PRECISION W4(NCELET), W5(NCELET), W6(NCELET) DOUBLE PRECISION W7(NCELET), W8(NCELET) DOUBLE PRECISION RDEVEL(NRDEVE), RTUSER(NRTUSE), RA(*) C C VARIABLES LOCALES C INTEGER IDEBIA , IDEBRA INTEGER IVAR , IVARSC , IVARUT , IVAR0 INTEGER IEL , IPHAS , IFAC INTEGER IPCROM , IPCVST INTEGER IKIPH , IEIPH , IOMGIP , IPHYDP INTEGER IR11IP , IR22IP , IR33IP INTEGER IXCHCL , IXCKCL , IXNPCL , ICLA , ICHA INTEGER INC , ICCOCG , NSWRGP , IMLIGP , IWARNP INTEGER IFINRA , ICOEFA , ICOEFB INTEGER IDIMTE , ITENSO C DOUBLE PRECISION X2 , XK , XE , RHOVST DOUBLE PRECISION EPSRGP , CLIMGP , EXTRAP C C C*********************************************************************** C C======================================================================= C 1. INITIALISATION C======================================================================= C IDEBIA = IDBIA0 IDEBRA = IDBRA0 C C --- Numero du scalaire a traiter : ISCAL C C --- Numero de la variable associee au scalaire a traiter ISCAL IVAR = ISCA(ISCAL) C C --- Numero du scalaire eventuel associe dans le cas fluctuation C ISCALA et numero de variable de calcul IF (ISCALA.GT.0) THEN IVARSC = ISCA(ISCALA) ELSE IVARSC = 0 ENDIF C C --- Numero de phase associee au scalaire ISCAL IPHAS = IPHSCA(ISCAL) C C --- Numero des variables de calcul IF ( ITYTUR(IPHAS).EQ.2 .OR. ITURB(IPHAS).EQ.50 ) THEN IKIPH = IK (IPHAS) IEIPH = IEP (IPHAS) ELSEIF ( ITYTUR(IPHAS).EQ.3 ) THEN IR11IP = IR11(IPHAS) IR22IP = IR22(IPHAS) IR33IP = IR33(IPHAS) IEIPH = IEP (IPHAS) ELSEIF ( ITURB(IPHAS).EQ.60 ) THEN IKIPH = IK (IPHAS) IOMGIP = IOMG(IPHAS) ENDIF C C --- Numero des grandeurs physiques IPCROM = IPPROC(IROM(IPHAS)) IPCVST = IPPROC(IVISCT(IPHAS)) C C C======================================================================= C 2. PRISE EN COMPTE DES TERMES SOURCES DE PRODUCTION PAR LES GRADIENTS C ET DE DISSIPATION C======================================================================= C IF ( ITYTUR(IPHAS).EQ.2 .OR. ITYTUR(IPHAS).EQ.3 & .OR. ITURB(IPHAS).EQ.50 .OR. ITURB(IPHAS).EQ.60) THEN C INC = 1 ICCOCG = 1 IF (IVARSC.GT.0) THEN IVARUT = IVARSC ELSE C A defaut de savoir pour F4M on prend comme pour F3M IVARUT = ISCA(IF3M) ENDIF NSWRGP = NSWRGR(IVARUT) IMLIGP = IMLIGR(IVARUT) IWARNP = IWARNI(IVARUT) EPSRGP = EPSRGR(IVARUT) CLIMGP = CLIMGR(IVARUT) EXTRAP = EXTRAG(IVARUT) C C --> Calcul de FIM et X2 dans W7 et W8 C DO IEL = 1, NCEL W1(IEL) = ZERO W2(IEL) = ZERO W3(IEL) = ZERO W4(IEL) = ZERO W5(IEL) = ZERO W6(IEL) = ZERO W7(IEL) = ZERO W8(IEL) = 1.D0 ENDDO C C ---- W8 = X1 C DO ICLA = 1, NCLACP IXCHCL = ISCA(IXCH(ICLA)) IXCKCL = ISCA(IXCK(ICLA)) IXNPCL = ISCA(INP(ICLA )) DO IEL = 1, NCEL X2 = RTP(IEL,IXCHCL)+RTP(IEL,IXCKCL) & + RTP(IEL,IXNPCL)*XMASH(ICLA) W8(IEL) = W8(IEL) - X2 ENDDO ENDDO C C ---- W7 = FJM (kg/kg du melange gazeux) C IF (IVARSC.EQ.0) THEN DO ICHA = 1, NCHARB DO IEL = 1, NCEL W1(IEL) = W1(IEL) + RTP(IEL,ISCA(IF1M(ICHA))) W2(IEL) = W2(IEL) + RTP(IEL,ISCA(IF2M(ICHA))) ENDDO ENDDO DO IEL = 1, NCEL W7(IEL) = 1.D0 - & ( (W1(IEL) + W2(IEL) + RTP(IEL,ISCA(IF3M))) & / W8(IEL) ) ENDDO ELSE DO IEL = 1, NCEL W7(IEL) = RTP(IEL,IVARSC) / W8(IEL) ENDDO ENDIF C C --> Calcul des COEFA et COEFB de FIM afin d'en calculer son gradient C On alloue localement 2 tableaux de NFABOR pour le calcul C de COEFA et COEFB de FIM C ICOEFA = IDEBRA ICOEFB = ICOEFA + NFABOR IFINRA = ICOEFB + NFABOR CALL RASIZE ('CPTSVC',IFINRA) C =========== C DO IFAC = 1, NFABOR RA(ICOEFA+IFAC-1) = ZERO RA(ICOEFB+IFAC-1) = 1.D0 IF ( ITYPFB(IFAC,IPHAS).EQ.IENTRE ) THEN RA(ICOEFA+IFAC-1) = ZERO RA(ICOEFB+IFAC-1) = ZERO IF (IVARSC.EQ.0) RA(ICOEFA+IFAC-1) = 1.D0 ENDIF ENDDO C C En periodique et parallele, echange avant calcul du gradient C C Parallele IF(IRANGP.GE.0) THEN CALL PARCOM(W7) C =========== ENDIF C C Periodique IF(IPERIO.EQ.1) THEN IDIMTE = 0 ITENSO = 0 CALL PERCOM C =========== & ( IDIMTE , ITENSO , & W7 , W7 , W7 , & W7 , W7 , W7 , & W7 , W7 , W7 ) ENDIF C C IVAR0 = 0 (indique pour la periodicite de rotation que la variable C n'est pas la vitesse ni Rij) IVAR0 = 0 IPHYDP = 0 CALL GRDCEL C =========== & ( IDEBIA , IFINRA , & NDIM , NCELET , NCEL , NFAC , NFABOR , NFML , NPRFML , & NNOD , LNDFAC , LNDFBR , NCELBR , NPHAS , & NIDEVE , NRDEVE , NITUSE , NRTUSE , & IVAR0 , IMRGRA , INC , ICCOCG , NSWRGP , IMLIGP , IPHYDP , & IWARNP , NFECRA , EPSRGP , CLIMGP , EXTRAP , & IFACEL , IFABOR , IFMFBR , IFMCEL , IPRFML , & IPNFAC , NODFAC , IPNFBR , NODFBR , & IDEVEL , ITUSER , IA , & XYZCEN , SURFAC , SURFBO , CDGFAC , CDGFBO , XYZNOD , VOLUME , & W7 , W7 , W7 , & W7 , RA(ICOEFA) , RA(ICOEFB) , C FIM COEFA COEFB & W1 , W2 , W3 , C ------ ------ ------ & W4 , W5 , W6 , & RDEVEL , RTUSER , RA ) C DO IEL = 1, NCEL IF ( ITYTUR(IPHAS).EQ.2 .OR. ITURB(IPHAS).EQ.50 ) THEN XK = RTPA(IEL,IKIPH) XE = RTPA(IEL,IEIPH) ELSEIF ( ITYTUR(IPHAS).EQ.3 ) THEN XK = & 0.5D0*(RTPA(IEL,IR11IP)+RTPA(IEL,IR22IP)+RTPA(IEL,IR33IP)) XE = RTPA(IEL,IEIPH) ELSEIF ( ITURB(IPHAS).EQ.60 ) THEN XK = RTPA(IEL,IKIPH) XE = CMU*XK*RTPA(IEL,IOMGIP) ENDIF C RHOVST = PROPCE(IEL,IPCROM)*XE/ & (XK * RVARFL(ISCAL))*VOLUME(IEL) ROVSDT(IEL) = ROVSDT(IEL) + MAX(ZERO,RHOVST) SMBRS(IEL) = SMBRS(IEL) + & 2.D0*PROPCE(IEL,IPCVST)*VOLUME(IEL)/SIGMAS(ISCAL) & * (W1(IEL)**2 + W2(IEL)**2 + W3(IEL)**2) * W8(IEL) & - RHOVST*RTPA(IEL,IVAR) ENDDO C C On libere COEFA COEFB IFINRA = IDEBRA C ENDIF C C C C-------- C FORMATS C-------- C C C C---- C FIN C---- C RETURN C END c@z