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 USTSMA C ***************** C ------------------------------------------------------------- & ( IDBIA0 , IDBRA0 , & NDIM , NCELET , NCEL , NFAC , NFABOR , NFML , NPRFML , & NNOD , LNDFAC , LNDFBR , NCELBR , & NVAR , NSCAL , NPHAS , NCEPDP , NCKPDP , & NIDEVE , NRDEVE , NITUSE , NRTUSE , & NCESMP , IPHAS , IAPPEL , & IFACEL , IFABOR , IFMFBR , IFMCEL , IPRFML , & IPNFAC , NODFAC , IPNFBR , NODFBR , ICEPDC , ICETSM , ITYPSM , & IDEVEL , ITUSER , IA , & XYZCEN , SURFAC , SURFBO , CDGFAC , CDGFBO , XYZNOD , VOLUME , & DT , RTPA , PROPCE , PROPFA , PROPFB , & COEFA , COEFB , CKUPDC , SMACEL , & RDEVEL , RTUSER , RA ) C ------------------------------------------------------------- C*********************************************************************** C FONCTION : C ---------- c@foncb CFONC CFONC TERMES SOURCES DE MASSE CFONC POUR LA PHASE IPHAS CFONC CFONC IAPPEL = 1 : CFONC CALCUL DU NOMBRE DE CELLULES AVEC SOURCE DE MASSE CFONC NCESMP CFONC IAPPEL = 2 : CFONC REPERAGE DES CELLULES AVEC SOURCE DE MASSE CFONC ICETSM(NCESMP) CFONC IAPPEL = 3 : CFONC CALCUL DES VALEURS DES COEFS DE SOURCE DE MASSE CFONC CFONC L'equation de conservation de la masse devient : CFONC CFONC d(rho)/dt + div(rho u) = GAMMA CFONC - CFONC CFONC L'equation d'une variable f devient : CFONC CFONC d(f)/dt = ..... + GAMMA*(f_i - f) CFONC CFONC discretisee en : CFONC CFONC RHO*(f^(n+1) - f^(n))/DT = ..... CFONC + GAMMA*(f_i - f^(n+1)) CFONC CFONC CFONC Deux possibilites pour chaque variable f : CFONC - Flux de masse a la valeur de f ambiante CFONC --> f_i = f^(n+1) CFONC (l'equation de f n'est alors pas modifiee) CFONC - Flux de masse avec une valeur donnee pour f CFONC --> f_i specifie par l'utilisateur CFONC CFONC CFONC CFONC CFONC VARIABLES A REMPLIR PAR L'UTILISATEUR : CFONC ======================================= CFONC CFONC NCESMP : Nombre de cellules a source de masse CFONC CFONC ICETSM(IELTSM) : Numero de la IELTSMieme cellule a CFONC source de masse (IELTSM<=NCESMP) CFONC CFONC SMACEL(IEL,IPR(IPHAS)) : Valeur du flux de masse CFONC GAMMA (en kg/m^3/s) CFONC dans la IELieme cellule a source CFONC de masse CFONC CFONC ITYPSM(IEL,IVAR) : type de flux associe a la variable CFONC IVAR dans la IELeme cellule a CFONC source de masse (pour toutes les CFONC variables sauf IVAR=IPR(IPHAS)) CFONC + ITYPSM = 0 --> injection a la valeur ambiante CFONC de IVAR CFONC + ITYPSM = 1 --> injection a une valeur donnee CFONC de IVAR CFONC CFONC SMACEL(IEL,IVAR) : Valeur de f_i pour la variable CFONC IVAR (pour toutes les variables CFONC sauf IVAR=IPR(IPHAS)) CFONC CFONC CFONC REMARQUES CFONC ========= CFONC * Si ITYPSM(IEL,IVAR)=0, SMACEL(IEL,IVAR) CFONC n'est pas utilise CFONC * Si SMACEL(IEL,IPR(IPHAS))<0, CFONC on enleve de la masse au systeme, Code_Saturne CFONC utilise donc automatiquement f_i=f^(n+1) CFONC QUELLES QUE SOIENT LES VALEURS DE ITYPSM(IEL) CFONC et SMACEL(IEL,IVAR) CFONC CFONC * Si une variable n'est pas reliee a la phase iphas CFONC pour laquelle les informations precedentes ont ete CFONC completees, aucun terme source ne sera impose. CFONC CFONC * Pour un scalaire qui ne repondrait pas a l'equation CFONC d(rho f)/dt + d(rho U f)/dx = ... CFONC (champ convecteur different par exemple) CFONC il est incorrect d'imposer le terme source de masse CFONC comme fait ici (sauf en cas d'injection a la valeur CFONC ambiante). Il faut introduire directement le terme CFONC source comme un terme source scalaire dans ustssc. 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 AVEC TSM ! CARGU ! NIDEVE NRDEVE! E ! -> ! LONGUEUR DE IDEVEL RDEVEL ! CARGU ! NITUSE NRTUSE! E ! -> ! LONGUEUR DE ITUSER RTUSER ! CARGU ! IPHAS ! E ! -> ! NUMERO DE PHASE ! CARGU ! IAPPEL ! E ! -> ! INDIQUE LES DONNES A RENVOYER ! 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 ! 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 ! RTPA ! TR ! -> ! VARIABLES DE CALCUL AU CENTRE DES ! CARGU ! (NCELET,*) ! ! ! CELLULES (INSTANT 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 ! CKUPDC(NCEPDP! TR ! -> ! TABLEAU DE TRAVAIL POUR PDC ! CARGU ! , NCKPDP)! ! ! ! CARGU ! SMACEL ! TR ! <-> ! VALEUR DES VARIABLES ASSOCIEE A LA ! CARGU ! (NCESMP,NVAR)! ! ! SOURCE DE MASSE ! CARGU ! ! ! ! POUR IVAR=IPR, SMACEL=FLUX DE MASSE ! 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 "pointe.h" INCLUDE "numvar.h" INCLUDE "entsor.h" INCLUDE "optcal.h" INCLUDE "cstphy.h" INCLUDE "cstnum.h" INCLUDE "parall.h" INCLUDE "period.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 IPHAS , IAPPEL C INTEGER IFACEL(2,NFAC) , IFABOR(NFABOR) INTEGER IFMFBR(NFABOR) , IFMCEL(NCELET) INTEGER IPRFML(NFML,NPRFML) INTEGER IPNFAC(NFAC+1), NODFAC(LNDFAC) INTEGER IPNFBR(NFABOR+1), NODFBR(LNDFBR) INTEGER ICEPDC(NCEPDP) INTEGER ICETSM(NCESMP), ITYPSM(NCESMP,NVAR) INTEGER IDEVEL(NIDEVE), 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), RTPA(NCELET,*) DOUBLE PRECISION PROPCE(NCELET,*) DOUBLE PRECISION PROPFA(NFAC,*), PROPFB(NFABOR,*) DOUBLE PRECISION COEFA(NFABOR,*), COEFB(NFABOR,*) DOUBLE PRECISION CKUPDC(NCEPDP,NCKPDP) DOUBLE PRECISION SMACEL(NCESMP,NVAR) DOUBLE PRECISION RDEVEL(NRDEVE), RTUSER(NRTUSE), RA(*) C C VARIABLES LOCALES C INTEGER IDEBIA, IDEBRA INTEGER IELTSM INTEGER IFAC, IFML, ICOUL, IUTILE, II C DOUBLE PRECISION VENT, VENT2 DOUBLE PRECISION DH, USTAR2 DOUBLE PRECISION XKENT, XEENT DOUBLE PRECISION FLUCEL DOUBLE PRECISION VTOT , GAMMA C C*********************************************************************** C IDEBIA = IDBIA0 IDEBRA = IDBRA0 C IF(IAPPEL.EQ.1.OR.IAPPEL.EQ.2) THEN C C======================================================================= C 1. POUR CHAQUE PHASE : UN OU DEUX APPELS C C PREMIER APPEL : C C IAPPEL = 1 : NCESMP : CALCUL DU NOMBRE DE CELLULES C AVEC TERME SOURCE DE MASSE C C C DEUXIEME APPEL (POUR LES PHASES AVEC NCESMP > 0) : C C IAPPEL = 2 : ICETSM : REPERAGE DU NUMERO DES CELLULES C AVEC TERME SOURCE DE MASSE C C C REMARQUES : C C Ne pas utiliser SMACEL dans cette section C (il est rempli au troisieme appel, IAPPEL = 3) C C Ne pas utiliser ICETSM dans cette section C au premier appel (IAPPEL = 1) C C On passe ici a chaque pas de temps C (ATTENTION au cout calcul de vos developpements) C C======================================================================= C C --------------------------------------------------------------------- C 1.1 A completer par l'utilisateur : selection des cellules C ----------------------------------------------------------- C C Exemple 1 : Aucune source de masse (defaut) IELTSM = 0 C C C Exemple 2 : Sources de masse pour la phase 1 C dans les cellules ayant une face de couleur 6 C et dans les cellules dont le centre est a x < 2 C C Dans ce test en deux parties, il faut faire attention a C ne pas compter les cellules deux fois (une cellule dont une C face est couleur 6 peut aussi etre a x < 2, mais il ne C faut la compter qu'une seule fois). Il faut egalement noter C que lors du premier passage, le tableau ICETSM n'existe pas C encore (ne pas l'utiliser en dehors des tests IAPPEL.EQ.2). C IUTILE = 0 IF(IUTILE.EQ.1) THEN C IF(IPHAS.EQ.1) THEN C IELTSM = 0 C C Cellules dont le centre est a 250 < x < 500 DO II = 1, NCEL IF (XYZCEN(1,II).LT.500.D0.AND. & XYZCEN(1,II).GT.250.D0)THEN IELTSM = IELTSM + 1 IF (IAPPEL.EQ.2) ICETSM(IELTSM) = II ENDIF ENDDO C C Cellules de bord dont une face est de couleur 3 DO IFAC = 1, NFABOR IFML = IFMFBR(IFAC) ICOUL = IPRFML(IFML,1) IF (ICOUL.EQ.3) THEN II = IFABOR(IFAC) C On ne comptabilise cette cellule que si on ne l'a pas deja vue C pour cela on prend la negation du test prededent IF (.NOT.(XYZCEN(1,II).LT.500.D0.AND. & XYZCEN(1,II).GT.250.D0) )THEN IELTSM = IELTSM + 1 IF (IAPPEL.EQ.2) ICETSM(IELTSM) = II ENDIF ENDIF ENDDO C C ELSE IELTSM = 0 ENDIF C ENDIF C C --------------------------------------------------------------------- C 1.2 Sous section generique a ne pas modifier C --------------------------------------------- C C --- Pour IAPPEL = 1, C Renseigner NCESMP, nombre de cellules avec terme source de masse C Le bloc ci dessous est valable pourles 2 exemples ci dessus C IF (IAPPEL.EQ.1) THEN NCESMP = IELTSM ENDIF C C----------------------------------------------------------------------- C ELSEIF(IAPPEL.EQ.3) THEN C C======================================================================= C C 2. POUR CHAQUE PHASE AVEC NCESMP > 0 , TROISIEME APPEL C C TROISIEME APPEL (POUR LES PHASES AVEC NCESMP > 0) : C C IAPPEL = 3 : ITYPSM : TYPE DE SOURCE DE MASSE C SMACEL : SOURCE DE MASSE C C C REMARQUE : C C ATTENTION, Si on positionne ITYPSM(IEL,IVAR) A 1, IL FAUT C egalement renseigner SMACEL(IEL,IVAR) C C======================================================================= C C C --------------------------------------------------------------------- C 2.1 A completer par l'utilisateur ITYPSM et SMACEL C ----------------------------------------------------- C C Exemple 1 : simulation d'une entree par des termes de source de masse C et affichage du flux de masse total pour la phase 1 C IF(IPHAS.EQ.1) THEN C VENT = 0.1D0 VENT2 = VENT**2 DH = 0.5D0 C Calcul de la vitesse de frottement au carre (USTAR2) C et de k et epsilon en entree (XKENT et XEENT) a partir C de lois standards en conduite circulaire C (leur initialisation est inutile mais plus propre) USTAR2 = 0.D0 XKENT = EPZERO XEENT = EPZERO C CALL KEENDB C =========== & ( VENT2, DH, RO0(IPHAS), VISCL0(IPHAS), CMU, XKAPPA, & USTAR2, XKENT, XEENT ) C FLUCEL = 0.D0 DO IELTSM = 1, NCESMP SMACEL(IELTSM,IPR(IPHAS)) = 30000.D0 ITYPSM(IELTSM,IV(IPHAS)) = 1 SMACEL(IELTSM,IV(IPHAS)) = VENT IF (ITYTUR(IPHAS).EQ.2) THEN ITYPSM(IELTSM,IK(IPHAS)) = 1 SMACEL(IELTSM,IK(IPHAS)) = XKENT ITYPSM(IELTSM,IEP(IPHAS)) = 1 SMACEL(IELTSM,IEP(IPHAS)) = XEENT ELSE IF (ITYTUR(IPHAS).EQ.3) THEN ITYPSM(IELTSM,IR11(IPHAS)) = 1 ITYPSM(IELTSM,IR12(IPHAS)) = 1 ITYPSM(IELTSM,IR13(IPHAS)) = 1 ITYPSM(IELTSM,IR22(IPHAS)) = 1 ITYPSM(IELTSM,IR23(IPHAS)) = 1 ITYPSM(IELTSM,IR33(IPHAS)) = 1 SMACEL(IELTSM,IR11(IPHAS)) = 2.D0/3.D0*XKENT SMACEL(IELTSM,IR12(IPHAS)) = 0.D0 SMACEL(IELTSM,IR13(IPHAS)) = 0.D0 SMACEL(IELTSM,IR22(IPHAS)) = 2.D0/3.D0*XKENT SMACEL(IELTSM,IR23(IPHAS)) = 0.D0 SMACEL(IELTSM,IR33(IPHAS)) = 2.D0/3.D0*XKENT ITYPSM(IELTSM,IEP(IPHAS)) = 1 SMACEL(IELTSM,IEP(IPHAS)) = XEENT ELSE IF (ITURB(IPHAS).EQ.50) THEN ITYPSM(IELTSM,IK(IPHAS)) = 1 SMACEL(IELTSM,IK(IPHAS)) = XKENT ITYPSM(IELTSM,IEP(IPHAS)) = 1 SMACEL(IELTSM,IEP(IPHAS)) = XEENT ITYPSM(IELTSM,IPHI(IPHAS)) = 1 SMACEL(IELTSM,IPHI(IPHAS)) = 2.D0/3.D0 C Il n'y a pas de terme source de masse dans l'equation de f_barre ELSE IF (ITURB(IPHAS).EQ.60) THEN ITYPSM(IELTSM,IK(IPHAS)) = 1 SMACEL(IELTSM,IK(IPHAS)) = XKENT ITYPSM(IELTSM,IOMG(IPHAS))= 1 SMACEL(IELTSM,IOMG(IPHAS))= XEENT/CMU/XKENT ENDIF IF(NSCAL.GT.0) THEN DO II = 1, NSCAL IF(IPHSCA(II).EQ.IPHAS) THEN ITYPSM(IELTSM,ISCA(II)) = 1 SMACEL(IELTSM,ISCA(II)) = 1.D0 ENDIF ENDDO ENDIF FLUCEL = FLUCEL+ & VOLUME(ICETSM(IELTSM))*SMACEL(IELTSM,IPR(IPHAS)) ENDDO C IF (IRANGP.GE.0) THEN CALL PARSOM (FLUCEL) ENDIF C IF (IWARNI(IPR(IPHAS)).GE.1) THEN WRITE(NFECRA,1000) IPHAS, FLUCEL ENDIF C ENDIF C C----------------------------------------------------------------------- C C Exemple 2 : simulation d'un soutirage (par une pompe par exemple) C total de 80 000 kg/s C On suppose que l'on souhaite repartir uniformement ce C puits de masse sur les NCESMP cellules selectionnees C plus haut. C C C Le test sur IUTILE permet de ne pas passer dans l'exemple si C on oublie de l'eliminer, lors de la mise en place d'un calcul C reel. C IUTILE = 0 IF(IUTILE.EQ.1) THEN C IF(IPHAS.EQ.1) THEN C C Calcul du volume total de la zone ou est impose le terme source C (le cas des calculs paralleles est prevu avec parsom) VTOT = 0.D0 DO IELTSM = 1, NCESMP VTOT = VTOT + VOLUME(ICETSM(IELTSM)) ENDDO IF (IRANGP.GE.0) THEN CALL PARSOM (VTOT) ENDIF C C Le puits de masse est GAMMA = -80000/VTOT en kg/(m3 s) C (quel que soit le nombre de cellules NCESMP) C On l'impose ci-dessous (avec un test au cas ou VTOT=0) C On calcule au passage le terme puits total pour verification. C IF (VTOT.GT.0.D0) THEN GAMMA = -80000.D0/VTOT ELSE WRITE(NFECRA,9000) IPHAS, VTOT CALL CSEXIT (1) ENDIF C FLUCEL = 0.D0 DO IELTSM = 1, NCESMP SMACEL(IELTSM,IPR(IPHAS)) = GAMMA FLUCEL = FLUCEL+ & VOLUME(ICETSM(IELTSM))*SMACEL(IELTSM,IPR(IPHAS)) ENDDO C IF (IRANGP.GE.0) THEN CALL PARSOM (FLUCEL) ENDIF C IF (IWARNI(IPR(IPHAS)).GE.1) THEN WRITE(NFECRA,2000) IPHAS, FLUCEL, VTOT ENDIF C ENDIF C ENDIF C C----------------------------------------------------------------------- C ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(/,'PHASE ',I3, & ' : FLUX DE MASSE GENERE DANS LE DOMAINE : ',E14.5,/) C 2000 FORMAT(/,'PHASE ',I3, & ' : FLUX DE MASSE GENERE DANS LE DOMAINE : ',E14.5,/, &' REPARTI SUR UN VOLUME : ',E14.5) C 9000 FORMAT(/,'PHASE ',I3, & ' : ERREUR DANS USTSMA ',/, &' LE VOLUME DE LA ZONE AVEC PUITS DE MASSE VAUT = ',E14.5,/) C RETURN C END c@z