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 CLIPKE C ***************** C ------------------------------------------------------------- & ( NCELET , NCEL , NVAR , NPHAS , & IPHAS , ICLIP , IWARNK , & PROPCE , RTP ) C ------------------------------------------------------------- C*********************************************************************** C FONCTION : C ---------- c@foncb CFONC CFONC CLIPPING DE K ET EPSILON CFONC c@fonce C----------------------------------------------------------------------- C ARGUMENTS c@argub CARGU ARGUMENTS CARGU .______________.____._____.______________________________________. CARGU ! NOM !TYPE!MODE ! ROLE ! CARGU !______________!____!_____!______________________________________! CARGU ! NVAR ! E ! -> ! NOMBRE DE VARIABLES ! CARGU ! NCELET ! E ! -> ! NOMBRE D'ELEMENTS HALO COMPRIS ! CARGU ! NCEL ! E ! -> ! NOMBRE D'ELEMENTS ACTIFS ! CARGU ! NPHAS ! E ! -> ! NOMBRE DE PHASES ! CARGU ! IPHAS ! E ! -> ! NUMERO DE LA PHASE A TRAITER ! CARGU ! ICLIP ! E ! -> ! INDICATEUR = 0 ON UTILISE VISCL0 ! CARGU ! ! ! ! SINON ON UTILISE VISCL ! CARGU ! IWARNK ! E ! -> ! NIVEAU D'IMPRESSION ! CARGU ! PROPCE ! TR ! <-> ! TABLEAUX DES VARIABLES AU PDT COURANT! CARGU !(NCELET,* ! ! ! ! CARGU ! RTP ! TR ! <-> ! TABLEAUX DES VARIABLES AU PDT COURANT! CARGU ! (NCELET )! ! ! ! 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*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C INCLUDE "paramx.h" INCLUDE "numvar.h" INCLUDE "cstphy.h" INCLUDE "cstnum.h" INCLUDE "entsor.h" INCLUDE "optcal.h" INCLUDE "parall.h" C C*********************************************************************** C C ARGUMENTS C INTEGER NVAR, NCELET, NCEL, NPHAS INTEGER IPHAS, ICLIP, IWARNK DOUBLE PRECISION PROPCE(NCELET,*) DOUBLE PRECISION RTP(NCELET,NVAR) C C VARIABLES LOCALES C INTEGER ICLPKE,IEL,ICLPK2,ICLPE2 INTEGER IVAR,IPP,II,IIKIPH,IIEIPH,IIVISC,IIROMC DOUBLE PRECISION XEPMIN,XEPM,XE,XKMIN,XKM,XK, VMIN, VMAX, VAR DOUBLE PRECISION EPZ2 C C*********************************************************************** C IIKIPH = IK(IPHAS) IIEIPH = IEP(IPHAS) IIVISC = IPPROC(IVISCL(IPHAS)) IIROMC = IPPROC(IROM(IPHAS)) C C C Une petite valeur pour eviter des valeurs exactement nulles. C EPZ2 = EPZERO**2 C C======================================================================= C ---> Stockage Min et Max pour listing C======================================================================= C DO II = 1, 2 IF(II.EQ.1) THEN IVAR = IIKIPH ELSEIF(II.EQ.2) THEN IVAR = IIEIPH ENDIF IPP = IPPRTP(IVAR) C VMIN = GRAND VMAX = -GRAND DO IEL = 1, NCEL VAR = RTP(IEL,IVAR) VMIN = MIN(VMIN,VAR) VMAX = MAX(VMAX,VAR) ENDDO IF (IRANGP.GE.0) THEN CALL PARMAX (VMAX) C =========== CALL PARMIN (VMIN) C =========== ENDIF VARMNA(IPP) = VMIN VARMXA(IPP) = VMAX C ENDDO C C======================================================================= C ---> Detection des valeurs hors norme "physiques" C uniquement pour avertissement C ou dans le cas ICLKEP = 1 C======================================================================= C IF (IWARNK.GE.2.OR.ICLKEP(IPHAS).EQ.1) THEN C IF(ICLIP.EQ.1) THEN C XKM = 1296.D0*SQRT(CMU)/ALMAX(IPHAS)**2 XEPM = 46656.D0*CMU/ALMAX(IPHAS)**4 ICLPKE = 0 DO IEL=1,NCEL XK = RTP(IEL,IIKIPH) XE = RTP(IEL,IIEIPH) XKMIN = XKM*(PROPCE(IEL,IIVISC)/PROPCE(IEL,IIROMC))**2 XEPMIN = XEPM*(PROPCE(IEL,IIVISC)/PROPCE(IEL,IIROMC))**3 IF(XK.LE.XKMIN.OR.XE.LE.XEPMIN) THEN IF(ICLKEP(IPHAS).EQ.1) THEN RTP(IEL,IIKIPH) = XKMIN RTP(IEL,IIEIPH) = XEPMIN ENDIF ICLPKE = ICLPKE + 1 ENDIF ENDDO C ELSEIF(ICLIP.EQ.0) THEN C XKMIN = 1296.D0*SQRT(CMU)/ALMAX(IPHAS)**2* & (VISCL0(IPHAS)/RO0(IPHAS))**2 XEPMIN = 46656.D0*CMU/ALMAX(IPHAS)**4* & (VISCL0(IPHAS)/RO0(IPHAS))**3 ICLPKE = 0 DO IEL=1,NCEL XK = RTP(IEL,IIKIPH) XE = RTP(IEL,IIEIPH) IF(XK.LE.XKMIN.OR.XE.LE.XEPMIN) THEN IF(ICLKEP(IPHAS).EQ.1) THEN RTP(IEL,IIKIPH) = XKMIN RTP(IEL,IIEIPH) = XEPMIN ENDIF ICLPKE = ICLPKE + 1 ENDIF ENDDO C ELSE C WRITE(NFECRA,1000)ICLIP CALL CSEXIT (1) C ENDIF C IF (IRANGP.GE.0) CALL PARCPT (ICLPKE) C =========== C C --- Impression eventuelle C IF(IWARNK.GE.2) THEN C WRITE(NFECRA,1010)ICLPKE C ENDIF C C --- Stockage nb de clippings pour listing C IF(ICLKEP(IPHAS).EQ.1) THEN ICLPMN(IPPRTP(IIKIPH)) = ICLPKE ICLPMN(IPPRTP(IIEIPH)) = ICLPKE ENDIF C ENDIF C C======================================================================= C ---> Clipping "standard" ICLKEP = 0 C======================================================================= C IF(ICLKEP(IPHAS).EQ.0) THEN C ICLPK2 = 0 ICLPE2 = 0 DO IEL = 1, NCEL XK = RTP(IEL,IIKIPH) XE = RTP(IEL,IIEIPH) IF (ABS(XK).LE.EPZ2) THEN ICLPK2 = ICLPK2 + 1 RTP(IEL,IIKIPH) = MAX(RTP(IEL,IIKIPH),EPZ2) ELSEIF(XK.LE.0.D0) THEN ICLPK2 = ICLPK2 + 1 RTP(IEL,IIKIPH) = -XK ENDIF IF (ABS(XE).LE.EPZ2) THEN ICLPE2 = ICLPE2 + 1 RTP(IEL,IIEIPH) = MAX(RTP(IEL,IIEIPH),EPZ2) ELSEIF(XE.LE.0.D0) THEN ICLPE2 = ICLPE2 + 1 RTP(IEL,IIEIPH) = -XE ENDIF ENDDO C IF (IRANGP.GE.0) THEN CALL PARCPT (ICLPK2) C =========== CALL PARCPT (ICLPE2) C =========== ENDIF C C --- Stockage nb de clippings pour listing C ICLPMN(IPPRTP(IIKIPH)) = ICLPK2 ICLPMN(IPPRTP(IIEIPH)) = ICLPE2 C ENDIF C C C======================================================================= C ---> Formats C======================================================================= C 1000 FORMAT( &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/, &'@ @@ ATTENTION : ARRET DANS clipke ',/, &'@ ********* ',/, &'@ APPEL DE clipke AVEC OPTION = ',I10 ,/, &'@ Phase : ',I10 ,/, &'@ ',/, &'@ Le calcul ne peut pas etre execute. ',/, &'@ ',/, &'@ Contacter l''assistance. ',/, &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/) 1010 FORMAT( & I10,' VALEURS DU K-EPS AU DELA DES ECHELLES BASEES SUR ALMAX') C RETURN C END c@z