Sources Esope | Cast3M

cli22r
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 &lt; 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