C CLI22R SOURCE CB215821 20/11/25 13:20:37 10792 SUBROUTINE CLI22R(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, & ICHPSU,LRECP,LRECV,IPC,ICHLIM,ICHRES,ICHRLI) C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : CLI22R C C DESCRIPTION : Subroutine appellée par CLIM22 C calcul de RESIDU et CLIM at the board C OPTION: 'RESE' 2D, 3D C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) C C AUTEUR : A. Beccantini, DEN/DM2S/SFME/LTMF C C************************************************************************ C C APPELES (Calcul) : C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : C C************************************************************************ C C We know everything outside C C 1) PC < PF C Condition de type reservoir C C 2) PC > PF C We stop the mass flux C We put zero velocity on the wall C We put P = PF at the wall C IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMLMOTS -INC SMELEME POINTEUR MELEFC.MELEME -INC SMLENTI POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI -INC SMCHPOI POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, & MPPC.MPOVAL, MPLIM.MPOVAL, & MPRES.MPOVAL, MPRLI.MPOVAL C---------------------------------------- C**** Variables de COOPTIO C---------------------------------------- C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM, IFICLE, IPREFI C & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV C INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU,IPC & ,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,I,NSP REAL*8 VOLU,SURF,PC,CNX,CNY,CNZ & ,RF,PF,PCR,TOP,BOT & ,GAMF & ,UN,RHO,P,UX,UY,UZ CHARACTER*(8) TYPE C------------------------------------------------------------ -INC SMLREEL POINTEUR MLRECP.MLREEL, MLRECV.MLREEL C C------------------------------------------------------------- C******* Les fractionines massiques ************************** C------------------------------------------------------------- SEGMENT FRAMAS REAL*8 YET(NSP) ENDSEGMENT POINTEUR YF.FRAMAS C------------------------------------------------------ C**** KRIPAD pour la correspondance global/local C------------------------------------------------------ CALL KRIPAD(MELEMC,MLEMC) CALL KRIPAD(MELECB,MLEMCB) CALL KRIPAD(MELEMF,MLEMF) C------------------------------------------------------ C**** CHPOINTs de la table DOMAINE C------------------------------------------------------ CALL LICHT(INORM,MPNORM,TYPE,ICEL) CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) C------------------------------------------------------ C**** CHPOINTs des variables C------------------------------------------------------ CALL LICHT(IPC,MPPC,TYPE,ICEL) CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) CALL LICHT(ICHRES,MPRES,TYPE,ICEL) CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL) C--------------------------------------------------------- C**** Boucle sur le face pour le calcul du flux C--------------------------------------------------------- MLRECV = LRECV MLRECP = LRECP SEGACT MLRECV SEGACT MLRECP SEGACT MELEFC SEGINI YF NFAC=MELEFC.NUM(/2) CNZ=0.0D0 DO 1 IFAC=1,NFAC,1 NGF=MELEFC.NUM(1,IFAC) NGC=MELEFC.NUM(2,IFAC) NLF=MLEMF.LECT(NGF) NLC=MLEMC.LECT(NGC) NLCB=MLEMCB.LECT(NGF) VOLU=MPVOL.VPOCHA(NLC,1) SURF=MPSURF.VPOCHA(NLF,1) C---------------------------------------------- C In CASTEM les normales sont sortantes C---------------------------------------------- CNX=-1*MPNORM.VPOCHA(NLF,1) CNY=-1*MPNORM.VPOCHA(NLF,2) IF(IDIM.EQ.3)THEN CNZ=-1*MPNORM.VPOCHA(NLF,3) ENDIF C---------------------------- C Variables au centre C---------------------------- PC=MPPC.VPOCHA(NLC,1) C---------------------------- C Variables à la face C---------------------------- RF=MPLIM.VPOCHA(NLCB,1) PF=MPLIM.VPOCHA(NLCB,2) DO 101 I=1,(NSP-1) YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I) 101 CONTINUE c------------------------------------------------------------- c Computing GAMMA at the face-center c------------------------------------------------------------- top=0.0D0 bot=0.0D0 do 103 i=1,(nsp-1) top=top+yf.yet(i)*(MLRECP.PROG(i)-MLRECP.PROG(nsp)) bot=bot+yf.yet(i)*(MLRECV.PROG(i)-MLRECV.PROG(nsp)) 103 continue top=MLRECP.PROG(nsp)+top bot=MLRECV.PROG(nsp)+bot GAMF=top/bot C---------------------------------------- C******* PCR, P, RHO and UN on the border C---------------------------------------- IF(PF .LT. PC)THEN C C P_{interface}=PF C \rho_{interface}=RF C U_{interface}=0.0D0 C Y_{interface}=YF C MPRLI.VPOCHA(NLCB,1)=RF MPRLI.VPOCHA(NLCB,2)=0.0D0 MPRLI.VPOCHA(NLCB,3)=0.0D0 IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=0.0D0 MPRLI.VPOCHA(NLCB,IDIM+2)=PF do 104 i=1,(nsp-1),1 MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I) 104 continue MPRES.VPOCHA(IFAC,1)=0.0D0 MPRES.VPOCHA(IFAC,2)=(PC*CNX)*SURF/VOLU MPRES.VPOCHA(IFAC,3)=(PC*CNY)*SURF/VOLU IF(IDIM.EQ.3) & MPRES.VPOCHA(IFAC,4)=(PC*CNZ)*SURF/VOLU MPRES.VPOCHA(IFAC,IDIM+2)=0.0D0 do 105 i=1,(nsp-1),1 MPRES.VPOCHA(IFAC,IDIM+2+I)=0.0D0 105 continue ELSE PCR=PF*((2.0D0/(GAMF+1.0D0))**((GAMF/(GAMF-1.0D0)))) P=MAX(PCR,PC) RHO=(P/PF)**(1.0D0/GAMF) RHO=RHO*RF C UN=(2*GAMF)/(GAMF-1.0D0) UN=UN*((PF/RF)-(P/RHO)) UN=MAX(UN,1.0D-16*((P/RHO)*0.5D0)) UN=UN**0.5D0 C UX=UN*CNX UY=UN*CNY UZ=UN*CNZ C MPRLI.VPOCHA(NLCB,1)=RHO MPRLI.VPOCHA(NLCB,2)=UX MPRLI.VPOCHA(NLCB,3)=UY IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ MPRLI.VPOCHA(NLCB,IDIM+2)=P do 106 i=1,(nsp-1),1 MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I) 106 continue C------------------------------------------------------- C******* Residuum (son SPG a le meme ordre que MELEFC) C------------------------------------------------------- MPRES.VPOCHA(IFAC,1)=RHO*UN*SURF/VOLU MPRES.VPOCHA(IFAC,2)=(RHO*UN*UX+(P*CNX))*SURF/VOLU MPRES.VPOCHA(IFAC,3)=(RHO*UN*UY+(P*CNY))*SURF/VOLU IF(IDIM.EQ.3) & MPRES.VPOCHA(IFAC,4)=(RHO*UN*UZ+(P*CNZ))*SURF/VOLU MPRES.VPOCHA(IFAC,IDIM+2)=((UN*GAMF*P/(GAMF-1.0D0)) + & (0.5D0*RHO*UN*UN*UN))*SURF/VOLU do 107 i=1,(nsp-1) MPRES.VPOCHA(IFAC,IDIM+2+I)=RHO*YF.YET(I)*UN*SURF/VOLU 107 continue ENDIF 1 CONTINUE C SEGDES MELEFC C SEGSUP MLEMC SEGSUP MLEMCB SEGSUP MLEMF SEGSUP YF C C SEGDES MPNORM SEGDES MPVOL SEGDES MPSURF SEGDES MPPC SEGDES MPLIM SEGDES MPRES SEGDES MPRLI SEGDES MLRECP SEGDES MLRECV C 9999 CONTINUE RETURN END